type TKeyByte = array[0..5] of Byte; TDesMode = (dmEncry, dmDecry); function zz(Str, Key: AnsiString): string; function EncryStr(Str, Key: AnsiString): AnsiString; function DecryStr(Str, Key: AnsiString): AnsiString; function EncryStrHex(Str, Key: AnsiString): AnsiString; function DecryStrHex(StrHex, Key: AnsiString): AnsiString;
procedure initPermutation(var inData: array of Byte); var newData: array[0..7] of Byte; i: Integer; begin FillChar(newData, 8, 0); for i := 0 to 63 do if (inData[BitIP[i] shr 3] and (1 shl (7- (BitIP[i] and $07)))) <> 0 then newData[i shr 3] := newData[i shr 3] or (1 shl (7-(i and $07))); for i := 0 to 7 do inData[i] := newData[i]; end;
procedure conversePermutation(var inData: array of Byte); var newData: array[0..7] of Byte; i: Integer; begin FillChar(newData, 8, 0); for i := 0 to 63 do if (inData[BitCP[i] shr 3] and (1 shl (7-(BitCP[i] and $07)))) <> 0 then newData[i shr 3] := newData[i shr 3] or (1 shl (7-(i and $07))); for i := 0 to 7 do inData[i] := newData[i]; end;
procedure expand(inData: array of Byte; var outData: array of Byte); var i: Integer; begin FillChar(outData, 6, 0); for i := 0 to 47 do if (inData[BitExp[i] shr 3] and (1 shl (7-(BitExp[i] and $07)))) <> 0 then outData[i shr 3] := outData[i shr 3] or (1 shl (7-(i and $07))); end;
procedure permutation(var inData: array of Byte); var newData: array[0..3] of Byte; i: Integer; begin FillChar(newData, 4, 0); for i := 0 to 31 do if (inData[BitPM[i] shr 3] and (1 shl (7-(BitPM[i] and $07)))) <> 0 then newData[i shr 3] := newData[i shr 3] or (1 shl (7-(i and $07))); for i := 0 to 3 do inData[i] := newData[i]; end;
function si(s,inByte: Byte): Byte; var c: Byte; begin c := (inByte and $20) or ((inByte and $1e) shr 1) or ((inByte and $01) shl 4); Result := (sBox[s][c] and $0f); end;
procedure permutationChoose1(inData: array of Byte; var outData: array of Byte); var i: Integer; begin FillChar(outData, 7, 0); for i := 0 to 55 do if (inData[BitPMC1[i] shr 3] and (1 shl (7-(BitPMC1[i] and $07)))) <> 0 then outData[i shr 3] := outData[i shr 3] or (1 shl (7-(i and $07))); end;
procedure permutationChoose2(inData: array of Byte; var outData: array of Byte); var i: Integer; begin FillChar(outData, 6, 0); for i := 0 to 47 do if (inData[BitPMC2[i] shr 3] and (1 shl (7-(BitPMC2[i] and $07)))) <> 0 then outData[i shr 3] := outData[i shr 3] or (1 shl (7-(i and $07))); end;
procedure cycleMove(var inData: array of Byte; bitMove: Byte); var i: Integer; begin for i := 0 to bitMove - 1 do begin inData[0] := (inData[0] shl 1) or (inData[1] shr 7); inData[1] := (inData[1] shl 1) or (inData[2] shr 7); inData[2] := (inData[2] shl 1) or (inData[3] shr 7); inData[3] := (inData[3] shl 1) or ((inData[0] and $10) shr 4); inData[0] := (inData[0] and $0f); end; end;
procedure makeKey(inKey: array of Byte; var outKey: array of TKeyByte); const bitDisplace: array[0..15] of Byte = ( 1,1,2,2, 2,2,2,2, 1,2,2,2, 2,2,2,1 ); var outData56: array[0..6] of Byte; key28l: array[0..3] of Byte; key28r: array[0..3] of Byte; key56o: array[0..6] of Byte; i: Integer; begin permutationChoose1(inKey, outData56);
for i := 0 to 15 do begin cycleMove(key28l, bitDisplace[i]); cycleMove(key28r, bitDisplace[i]); key56o[0] := (key28l[0] shl 4) or (key28l[1] shr 4); key56o[1] := (key28l[1] shl 4) or (key28l[2] shr 4); key56o[2] := (key28l[2] shl 4) or (key28l[3] shr 4); key56o[3] := (key28l[3] shl 4) or (key28r[0]); key56o[4] := key28r[1]; key56o[5] := key28r[2]; key56o[6] := key28r[3]; permutationChoose2(key56o, outKey[i]); end; end;
procedure encry(inData, subKey: array of Byte; var outData: array of Byte); var outBuf: array[0..5] of Byte; buf: array[0..7] of Byte; i: Integer; begin expand(inData, outBuf); for i := 0 to 5 do outBuf[i] := outBuf[i] xor subKey[i]; // outBuf xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx buf[0] := outBuf[0] shr 2; //xxxxxx -> 2 buf[1] := ((outBuf[0] and $03) shl 4) or (outBuf[1] shr 4); // 4 <- xx xxxx -> 4 buf[2] := ((outBuf[1] and $0f) shl 2) or (outBuf[2] shr 6); // 2 <- xxxx xx -> 6 buf[3] := outBuf[2] and $3f; // xxxxxx buf[4] := outBuf[3] shr 2; // xxxxxx buf[5] := ((outBuf[3] and $03) shl 4) or (outBuf[4] shr 4); // xx xxxx buf[6] := ((outBuf[4] and $0f) shl 2) or (outBuf[5] shr 6); // xxxx xx buf[7] := outBuf[5] and $3f; // xxxxxx for i := 0 to 7 do buf[i] := si(i, buf[i]); for i := 0 to 3 do outBuf[i] := (buf[i*2] shl 4) or buf[i*2+1]; permutation(outBuf); for i := 0 to 3 do outData[i] := outBuf[i]; end;
procedure desData(desMode: TDesMode; inData: array of Byte; var outData: array of Byte); // inData, outData 都为8Bytes,否则出错 var i, j: Integer; temp, buf: array[0..3] of Byte; begin for i := 0 to 7 do outData[i] := inData[i]; initPermutation(outData); if desMode = dmEncry then begin for i := 0 to 15 do begin for j := 0 to 3 do temp[j] := outData[j]; //temp = Ln for j := 0 to 3 do outData[j] := outData[j + 4]; //Ln+1 = Rn encry(outData, subKey[i], buf); //Rn ==Kn==> buf for j := 0 to 3 do outData[j + 4] := temp[j] xor buf[j]; //Rn+1 = Ln^buf end;
for j := 0 to 3 do temp[j] := outData[j + 4]; for j := 0 to 3 do outData[j + 4] := outData[j]; for j := 0 to 3 do outData[j] := temp[j]; end else if desMode = dmDecry then begin for i := 15 downto 0 do begin for j := 0 to 3 do temp[j] := outData[j]; for j := 0 to 3 do outData[j] := outData[j + 4]; encry(outData, subKey[i], buf); for j := 0 to 3 do outData[j + 4] := temp[j] xor buf[j]; end; for j := 0 to 3 do temp[j] := outData[j + 4]; for j := 0 to 3 do outData[j + 4] := outData[j]; for j := 0 to 3 do outData[j] := temp[j]; end; conversePermutation(outData); end;
//////////
function EncryStr(Str, Key: AnsiString): AnsiString; var StrByte, OutByte, KeyByte: array[0..7] of Byte; StrResult,StrResult1: AnsiString; I, J: Integer; strLength:integer; begin if (Length(Str) > 0) and (Ord(Str[Length(Str)]) = 0) then raise Exception.Create('Error: the last char is NULL char.'); if Length(Key) < 8 then while Length(Key) < 8 do Key := Key + AnsiChar(0);
strLength:=Length(Str) mod 8;
//while Length(Str) mod 8 <> 0 do Str := Str + AnsiChar(0); if Length(Str) mod 8 = 0 then begin Str := Str + AnsiChar(8); Str := Str + AnsiChar(8); Str := Str + AnsiChar(8); Str := Str + AnsiChar(8); Str := Str + AnsiChar(8); Str := Str + AnsiChar(8); Str := Str + AnsiChar(8); Str := Str + AnsiChar(8); end else begin
while Length(Str) mod 8 <> 0 do begin if strLength=1 then Str := Str + AnsiChar(7) else if strLength=2 then Str := Str + AnsiChar(6) else if strLength=3 then Str := Str + AnsiChar(5) else if strLength=4 then Str := Str + AnsiChar(4) else if strLength=5 then Str := Str + AnsiChar(3) else if strLength=6 then Str := Str + AnsiChar(2) else Str := Str + AnsiChar(1) //Str := Str + AnsiChar(8 - strLength);
end; end;
for J := 0 to 7 do KeyByte[J] := Ord(Key[J + 1]); makeKey(keyByte, subKey);
StrResult := '';
for I := 0 to Length(Str) div 8 - 1 do begin for J := 0 to 7 do StrByte[J] := Ord(Str[I * 8 + J + 1]); desData(dmEncry, StrByte, OutByte); for J := 0 to 7 do begin StrResult1 := AnsiChar(OutByte[J]); StrResult := StrResult + AnsiChar(OutByte[J]); end; end;
Result := StrResult; end;
function DecryStr(Str, Key: AnsiString): AnsiString; var StrByte, OutByte, KeyByte: array[0..7] of Byte; StrResult: AnsiString; I, J: Integer; begin if Length(Key) < 8 then while Length(Key) < 8 do Key := Key + AnsiChar(0);
for J := 0 to 7 do KeyByte[J] := Ord(Key[J + 1]); makeKey(keyByte, subKey);
StrResult := '';
for I := 0 to Length(Str) div 8 - 1 do begin for J := 0 to 7 do StrByte[J] := Ord(Str[I * 8 + J + 1]); desData(dmDecry, StrByte, OutByte); for J := 0 to 7 do StrResult := StrResult + AnsiChar(OutByte[J]); end; while (Length(StrResult) > 0) and ((Ord(StrResult[Length(StrResult)]) = 8) or (Ord(StrResult[Length(StrResult)]) = 7) or (Ord(StrResult[Length(StrResult)]) = 6) or (Ord(StrResult[Length(StrResult)]) = 5) or (Ord(StrResult[Length(StrResult)]) = 4) or (Ord(StrResult[Length(StrResult)]) = 3) or (Ord(StrResult[Length(StrResult)]) = 2) or (Ord(StrResult[Length(StrResult)]) = 1) or (Ord(StrResult[Length(StrResult)]) = 0)) do begin Delete(StrResult, Length(StrResult), 1); end; Result := StrResult; end;
//////////
function EncryStrHex(Str, Key: AnsiString): AnsiString; var StrResult, TempResult, Temp: AnsiString; I: Integer; begin TempResult := EncryStr(Str, Key); StrResult := ''; for I := 0 to Length(TempResult) - 1 do begin Temp := Format('%x', [Ord(TempResult[I + 1])]); if Length(Temp) = 1 then Temp := '0' + Temp; StrResult := StrResult + Temp; end; Result := StrResult; end;
function DecryStrHex(StrHex, Key: AnsiString): AnsiString; function HexToInt(Hex: AnsiString): Integer; var I, Res: Integer; ch: AnsiChar; begin Res := 0; for I := 0 to Length(Hex) - 1 do begin ch := Hex[I + 1]; if (ch >= '0') and (ch <= '9') then Res := Res * 16 + Ord(ch) - Ord('0') else if (ch >= 'A') and (ch <= 'F') then Res := Res * 16 + Ord(ch) - Ord('A') + 10 else if (ch >= 'a') and (ch <= 'f') then Res := Res * 16 + Ord(ch) - Ord('a') + 10 else raise Exception.Create('Error: not a Hex String'); end; Result := Res; end;
var Str, Temp: AnsiString; I: Integer; begin Str := ''; for I := 0 to Length(StrHex) div 2 - 1 do begin Temp := Copy(StrHex, I * 2 + 1, 2); Str := Str + AnsiChar(HexToInt(Temp)); end; Result := DecryStr(Str, Key); end;
function DesEncry_CBC_PKCS5(Str, Key, IV: String): String; var I, J, M: Integer; InData, KeyData, IVData, OutData: array[0..7] of byte ; begin Result := '';
M := 8 - (Length(Str) mod 8); for I := 1 to M do Str := Str + Chr(M); for I := Length(Key) to 7 do Key := Key + #0; for I := Length(IV ) to 7 do IV := IV + #0;
for I := 0 to 7 do begin KeyData[I] := ord(Key[I+1]); IVData [I] := ord(IV [I+1]); end; MakeKey(KeyData, SubKey);
for I := 0 to (Length(Str) div 8) - 1 do begin for J := 0 to 7 do begin InData[J] := ord(Str[I*8+J+1]) xor IVData[J]; end; DesData(dmEncry, InData, OutData); for J := 0 to 7 do begin IVData[J] := OutData[J]; end; for J := 0 to 7 do begin Result := Result + IntToHex(OutData[J], 2); end; end; end;
----------------------------------------------
-