function tripledes_set2keys(ctx: P_tripledes_ctx; key1, key2: PByte): Integer;
var
I: Integer;
begin
des_key_schedule (key1, @ctx.encrypt_subkeys);
des_key_schedule (key2, @(ctx.decrypt_subkeys[32]));
I := 0;
while (i < 32) do
begin
ctx.decrypt_subkeys[i] := ctx.encrypt_subkeys[30-i];
ctx.decrypt_subkeys[i+1] := ctx.encrypt_subkeys[31-i];
ctx.encrypt_subkeys[i+32] := ctx.decrypt_subkeys[62-i];
ctx.encrypt_subkeys[i+33] := ctx.decrypt_subkeys[63-i];
ctx.encrypt_subkeys[i+64] := ctx.encrypt_subkeys[i];
ctx.encrypt_subkeys[i+65] := ctx.encrypt_subkeys[i+1];
ctx.decrypt_subkeys[i+64] := ctx.decrypt_subkeys[i];
ctx.decrypt_subkeys[i+65] := ctx.decrypt_subkeys[i+1];
Inc(i, 2);
end;
Result := 0;
end;
function tripledes_set3keys(ctx: P_tripledes_ctx; key1, key2, key3: PByte): Integer;
var
I: Integer;
begin
des_key_schedule (key1, @ctx.encrypt_subkeys);
des_key_schedule (key2, @(ctx.decrypt_subkeys[32]));
des_key_schedule (key3, @(ctx.encrypt_subkeys[64]));
I := 0;
while (i < 32) do
begin
ctx.decrypt_subkeys[i] := ctx.encrypt_subkeys[94-i];
ctx.decrypt_subkeys[i+1] := ctx.encrypt_subkeys[95-i];
function is_weak_key(const key: PByte): Integer;
var
I, left, right, middle, cmp_result: Integer;
work: array [0..7] of Byte;
_key: PChar;
begin
_key := PChar(key);
for i := 0 to 7 do work[i] := Byte(_key[i]) and $fe;
left := 0; right := 63;
while(left <= right) do
begin
middle := (left + right) div 2;
cmp_result := working_memcmp(PChar(@work[0]), PChar(@weak_keys[middle]), 8);
if (cmp_result <> 0) then
begin
Result := -1;
Exit;
end;
if (cmp_result > 0) then left := middle + 1
else right := middle - 1;
end;
Result := 0;
end;
function memcmp(const a, b; n: Integer): Boolean;
var
_a, _b: PChar;
I: Integer;
begin
Result := False;
_a := @a; _b := @b;
for I := 0 to n do
begin
if (_a^ <> _b^) then
begin
Result := False;
Exit;
end else Result := True;
end;
end;
procedure DO_PERMUTATION(var a, temp, b: DWORD; const offset, mask: DWORD);
begin
temp := ((a shr offset) xor b) and mask;
b := temp xor b;
a := (temp shl offset) xor a;
end;
procedure DES_ROUND(var _from, _to, work: DWORD; var subkey: PDWORD);
begin
work := ((_from shl 1) or (_from shr 31)) xor subkey^; Inc(subkey);
_to := _to xor (sbox8[work and $3f]);
_to := _to xor (sbox6[(work shr 8) and $3f]);
_to := _to xor (sbox4[(work shr 16) and $3f]);
_to := _to xor (sbox2[(work shr 24) and $3f]);
work := ((_from shr 3) or (_from shl 29)) xor subkey^; Inc(subkey);
_to := _to xor (sbox7[work and $3f]);
_to := _to xor (sbox5[(work shr 8) and $3f]);
_to := _to xor (sbox3[(work shr 16) and $3f]);
_to := _to xor (sbox1[(work shr 24) and $3f]);
end;
procedure READ_64BIT_DATA(var data: PChar; var left, right: DWORD);
begin
left := (DWORD(Byte(data[0]) shl 24)) or (DWORD(Byte(data[1]) shl 16))
or (DWORD(Byte(data[2]) shl 8) or (DWORD(Byte(data[3]))));
right := (DWORD(Byte(data[4]) shl 24)) or (DWORD(Byte(data[5]) shl 16))
or (DWORD(Byte(data[6]) shl 8) or (DWORD(Byte(data[7]))));
end;
procedure WRITE_64BIT_DATA(var data: PChar; left, right: DWORD);
begin
data[0] := Char((left shr 24) and $ff);
data[1] := Char((left shr 16) and $ff);
data[2] := Char((left shr 8) and $ff);
data[3] := Char(left and $ff);
data[4] := Char((right shr 24) and $ff);
data[5] := Char((right shr 16) and $ff);
data[6] := Char((right shr 8) and $ff);
data[7] := Char(right and $ff);
end;
function selftest(): string;
const
key: array [0..7] of Byte = ($55, $55, $55,$55, $55, $55, $55, $55);
input: array [0..7] of Byte = ($FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);
aresult: array [0..7] of Byte = ($24, $6e, $9d, $b9, $c5, $50, $38, $1a);
var
I: Integer;
temp1, temp2, temp3: array [0..7] of Byte;
des: _des_ctx;
begin
for I := 0 to 63 do
begin
des_setkey (@des, @key);
des_ecb_crypt (@des, @input, @temp1, 0);
des_ecb_crypt (@des, @temp1, @temp2, 0);
des_setkey (@des, @temp2);
function working_memcmp( const a, b: PChar; n: DWORD): Integer;
var
_a, _b: PChar;
begin
_a := a; _b := b;
repeat
if (_a^ <> _b^) then
begin
Result := Integer(PByte(_a)^) - Integer(PByte(_b)^);
Exit;
end;
Inc(_a); Inc(_b);
until n > 0;
Result := 0;
end;
left := (leftkey_swap[(left shr 0) and $f] shl 3) or (leftkey_swap[(left shr 8) and $f] shl 2)
or (leftkey_swap[(left shr 16) and $f] shl 1) or (leftkey_swap[(left shr 24) and $f])
or (leftkey_swap[(left shr 5) and $f] shl 7) or (leftkey_swap[(left shr 13) and $f] shl 6)
or (leftkey_swap[(left shr 21) and $f] shl 5) or (leftkey_swap[(left shr 29) and $f] shl 4);
left := left and $0fffffff;
right := (rightkey_swap[(right shr 1) and $f] shl 3) or (rightkey_swap[(right shr 9) and $f] shl 2)
or (rightkey_swap[(right shr 17) and $f] shl 1) or (rightkey_swap[(right shr 25) and $f])
or (rightkey_swap[(right shr 4) and $f] shl 7) or (rightkey_swap[(right shr 12) and $f] shl 6)
or (rightkey_swap[(right shr 20) and $f] shl 5) or (rightkey_swap[(right shr 28) and $f] shl 4);
right := right and $0fffffff;
for round := 0 to 15 do
begin
left := ((left shl encrypt_rotate_tab[round]) or (left shr (28 - encrypt_rotate_tab[round]))) and $0fffffff;
right := ((right shl encrypt_rotate_tab[round]) or (right shr (28 - encrypt_rotate_tab[round]))) and $0fffffff;
subkey^ := ((left shl 4) and $24000000)
or ((left shl 28) and $10000000)
or ((left shl 14) and $08000000)
or ((left shl 18) and $02080000)
or ((left shl 6) and $01000000)
or ((left shl 9) and $00200000)
or ((left shr 1) and $00100000)
or ((left shl 10) and $00040000)
or ((left shl 2) and $00020000)
or ((left shr 10) and $00010000)
or ((right shr 13) and $00002000)
or ((right shr 4) and $00001000)
or ((right shl 6) and $00000800)
or ((right shr 1) and $00000400)
or ((right shr 14) and $00000200)
or (right and $00000100)
or ((right shr 5) and $00000020)
or ((right shr 10) and $00000010)
or ((right shr 3) and $00000008)
or ((right shr 18) and $00000004)
or ((right shr 26) and $00000002)
or ((right shr 24) and $00000001);
Inc(subkey);
subkey^ := ((left shl 15) and $20000000)
or ((left shl 17) and $10000000)
or ((left shl 10) and $08000000)
or ((left shl 22) and $04000000)
or ((left shr 2) and $02000000)
or ((left shl 1) and $01000000)
or ((left shl 16) and $00200000)
or ((left shl 11) and $00100000)
or ((left shl 3) and $00080000)
or ((left shr 6) and $00040000)
or ((left shl 15) and $00020000)
or ((left shr 4) and $00010000)
or ((right shr 2) and $00002000)
or ((right shl 8) and $00001000)
or ((right shr 14) and $00000808)
or ((right shr 9) and $00000400)
or ((right) and $00000200)
or ((right shl 7) and $00000100)
or ((right shr 7) and $00000020)
or ((right shr 3) and $00000011)
or ((right shl 2) and $00000004)
or ((right shr 21) and $00000002);
Inc(subkey);
end;
end;
function des_setkey(ctx: P_des_ctx; const key: PByte): Integer;
var
I: Integer;
begin
if( selftest_failed <> nil) then
begin
Result := -1;
Exit;
end;
des_key_schedule (key, @ctx.encrypt_subkeys);
I := 0;
while (i < 32) do
begin
ctx.decrypt_subkeys[i] := ctx.encrypt_subkeys[30-i];
ctx.decrypt_subkeys[i+1] := ctx.encrypt_subkeys[31-i];
Inc(i, 2);
end;
Result := 0;
end;
function des_ecb_crypt(ctx: P_des_ctx; const _from: PByte; _to: PByte; mode: Integer): Integer;
var
left, right, work: DWORD;
keys: PDWORD;
data: PChar;
begin
if mode <> 0 then keys := @ctx.decrypt_subkeys
else keys := @ctx.encrypt_subkeys;
function DES_EnCrypt(const aStr, acKey: string): string;
var
key, work_temp, temp1, temp2, temp3: array [0..7] of Byte;
work_s, key_s: string;
I, iLen, J: Integer;
des: _des_ctx;
begin
Result := '';
if (aStr = '') or (acKey = '') then Exit;
iLen := Length(aStr);
work_s := aStr;
if (iLen mod 8) <> 0 then
begin
SetLength(work_s, iLen + (8 - iLen mod 8));
FillMemory(@work_s[iLen + 1], 8 - iLen mod 8, 0);
iLen := Length(work_s);
end;
for J := 1 to iLen div 8 do
begin
key_s := Copy(acKey, 1, 8);
CopyMemory(@key, @key_s[1], Length(key_s));
FillMemory(@key[Length(key_s)], 8 - Length(key_s), 0);
CopyMemory(@work_temp, @work_s[J * 8 -7], 8);
for I := 0 to 63 do
begin
des_setkey (@des, @key);
des_ecb_crypt (@des, @work_temp, @temp1, 0);
des_ecb_crypt (@des, @temp1, @temp2, 0);
des_setkey (@des, @temp2);
des_ecb_crypt (@des, @temp1, @temp3, 1);
CopyMemory(@key, @temp3, 8);
CopyMemory(@work_temp, @temp1, 8);
end;
for I := 0 to 7 do
begin
Result := Result + Format('%.2X', [temp3[I]]);// Chr(temp3[I]);
end;
end;
end;