unit UDES;

interface

uses
  Windows;

var
  sbox1: array [0..63] of DWORD = (
    $00808200, $00000000, $00008000, $00808202, $00808002, $00008202, $00000002, $00008000,
    $00000200, $00808200, $00808202, $00000200, $00800202, $00808002, $00800000, $00000002,
    $00000202, $00800200, $00800200, $00008200, $00008200, $00808000, $00808000, $00800202,
    $00008002, $00800002, $00800002, $00008002, $00000000, $00000202, $00008202, $00800000,
    $00008000, $00808202, $00000002, $00808000, $00808200, $00800000, $00800000, $00000200,
    $00808002, $00008000, $00008200, $00800002, $00000200, $00000002, $00800202, $00008202,
    $00808202, $00008002, $00808000, $00800202, $00800002, $00000202, $00008202, $00808200,
    $00000202, $00800200, $00800200, $00000000, $00008002, $00008200, $00000000, $00808002);

  sbox2: array [0..63] of DWORD = (
    $40084010, $40004000, $00004000, $00084010, $00080000, $00000010, $40080010, $40004010,
    $40000010, $40084010, $40084000, $40000000, $40004000, $00080000, $00000010, $40080010,
    $00084000, $00080010, $40004010, $00000000, $40000000, $00004000, $00084010, $40080000,
    $00080010, $40000010, $00000000, $00084000, $00004010, $40084000, $40080000, $00004010,
    $00000000, $00084010, $40080010, $00080000, $40004010, $40080000, $40084000, $00004000,
    $40080000, $40004000, $00000010, $40084010, $00084010, $00000010, $00004000, $40000000,
    $00004010, $40084000, $00080000, $40000010, $00080010, $40004010, $40000010, $00080010,
    $00084000, $00000000, $40004000, $00004010, $40000000, $40080010, $40084010, $00084000);

  sbox3: array [0..63] of DWORD = (
    $00000104, $04010100, $00000000, $04010004, $04000100, $00000000, $00010104, $04000100,
    $00010004, $04000004, $04000004, $00010000, $04010104, $00010004, $04010000, $00000104,
    $04000000, $00000004, $04010100, $00000100, $00010100, $04010000, $04010004, $00010104,
    $04000104, $00010100, $00010000, $04000104, $00000004, $04010104, $00000100, $04000000,
    $04010100, $04000000, $00010004, $00000104, $00010000, $04010100, $04000100, $00000000,
    $00000100, $00010004, $04010104, $04000100, $04000004, $00000100, $00000000, $04010004,
    $04000104, $00010000, $04000000, $04010104, $00000004, $00010104, $00010100, $04000004,
    $04010000, $04000104, $00000104, $04010000, $00010104, $00000004, $04010004, $00010100);

  sbox4: array [0..63] of DWORD = (
    $80401000, $80001040, $80001040, $00000040, $00401040, $80400040, $80400000, $80001000,
    $00000000, $00401000, $00401000, $80401040, $80000040, $00000000, $00400040, $80400000,
    $80000000, $00001000, $00400000, $80401000, $00000040, $00400000, $80001000, $00001040,
    $80400040, $80000000, $00001040, $00400040, $00001000, $00401040, $80401040, $80000040,
    $00400040, $80400000, $00401000, $80401040, $80000040, $00000000, $00000000, $00401000,
    $00001040, $00400040, $80400040, $80000000, $80401000, $80001040, $80001040, $00000040,
    $80401040, $80000040, $80000000, $00001000, $80400000, $80001000, $00401040, $80400040,
    $80001000, $00001040, $00400000, $80401000, $00000040, $00400000, $00001000, $00401040);

  sbox5: array [0..63] of DWORD = (
    $00000080, $01040080, $01040000, $21000080, $00040000, $00000080, $20000000, $01040000,
    $20040080, $00040000, $01000080, $20040080, $21000080, $21040000, $00040080, $20000000,
    $01000000, $20040000, $20040000, $00000000, $20000080, $21040080, $21040080, $01000080,
    $21040000, $20000080, $00000000, $21000000, $01040080, $01000000, $21000000, $00040080,
    $00040000, $21000080, $00000080, $01000000, $20000000, $01040000, $21000080, $20040080,
    $01000080, $20000000, $21040000, $01040080, $20040080, $00000080, $01000000, $21040000,
    $21040080, $00040080, $21000000, $21040080, $01040000, $00000000, $20040000, $21000000,
    $00040080, $01000080, $20000080, $00040000, $00000000, $20040000, $01040080, $20000080);

  sbox6: array [0..63] of DWORD = (
    $10000008, $10200000, $00002000, $10202008, $10200000, $00000008, $10202008, $00200000,
    $10002000, $00202008, $00200000, $10000008, $00200008, $10002000, $10000000, $00002008,
    $00000000, $00200008, $10002008, $00002000, $00202000, $10002008, $00000008, $10200008,
    $10200008, $00000000, $00202008, $10202000, $00002008, $00202000, $10202000, $10000000,
    $10002000, $00000008, $10200008, $00202000, $10202008, $00200000, $00002008, $10000008,
    $00200000, $10002000, $10000000, $00002008, $10000008, $10202008, $00202000, $10200000,
    $00202008, $10202000, $00000000, $10200008, $00000008, $00002000, $10200000, $00202008,
    $00002000, $00200008, $10002008, $00000000, $10202000, $10000000, $00200008, $10002008);

  sbox7: array [0..63] of DWORD = (
    $00100000, $02100001, $02000401, $00000000, $00000400, $02000401, $00100401, $02100400,
    $02100401, $00100000, $00000000, $02000001, $00000001, $02000000, $02100001, $00000401,
    $02000400, $00100401, $00100001, $02000400, $02000001, $02100000, $02100400, $00100001,
    $02100000, $00000400, $00000401, $02100401, $00100400, $00000001, $02000000, $00100400,
    $02000000, $00100400, $00100000, $02000401, $02000401, $02100001, $02100001, $00000001,
    $00100001, $02000000, $02000400, $00100000, $02100400, $00000401, $00100401, $02100400,
    $00000401, $02000001, $02100401, $02100000, $00100400, $00000000, $00000001, $02100401,
    $00000000, $00100401, $02100000, $00000400, $02000001, $02000400, $00000400, $00100001);
    
  sbox8: array [0..63] of DWORD = (
    $08000820, $00000800, $00020000, $08020820, $08000000, $08000820, $00000020, $08000000,
    $00020020, $08020000, $08020820, $00020800, $08020800, $00020820, $00000800, $00000020,
    $08020000, $08000020, $08000800, $00000820, $00020800, $00020020, $08020020, $08020800,
    $00000820, $00000000, $00000000, $08020020, $08000020, $08000800, $00020820, $00020000,
    $00020820, $00020000, $08020800, $00000800, $00000020, $08020020, $00000800, $00020820,
    $08000800, $00000020, $08000020, $08020000, $08020020, $08000000, $00020000, $08000820,
    $00000000, $08020820, $00020020, $08000020, $08020000, $08000800, $08000820, $00000000,
    $08020820, $00020800, $00020800, $00000820, $00000820, $00020020, $08000000, $08020800);

  leftkey_swap: array [0..15] of DWORD = (
    $00000000, $00000001, $00000100, $00000101, $00010000, $00010001, $00010100, $00010101,
    $01000000, $01000001, $01000100, $01000101, $01010000, $01010001, $01010100, $01010101);

  rightkey_swap: array [0..15] of DWORD = (
    $00000000, $01000000, $00010000, $01010000, $00000100, $01000100, $00010100, $01010100,
    $00000001, $01000001, $00010001, $01010001, $00000101, $01000101, $00010101, $01010101);

  encrypt_rotate_tab: array [0..15] of Byte = (1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1);

  weak_keys: array [0..63, 0..7] of Byte =(
    ($00, $00, $00, $00, $00, $00, $00, $00 ), ($00, $00, $1e, $1e, $00, $00, $0e, $0e),
    ($00, $00, $e0, $e0, $00, $00, $f0, $f0 ), ($00, $00, $fe, $fe, $00, $00, $fe, $fe),
    ($00, $1e, $00, $1e, $00, $0e, $00, $0e ), ($00, $1e, $1e, $00, $00, $0e, $0e, $00),
    ($00, $1e, $e0, $fe, $00, $0e, $f0, $fe ), ($00, $1e, $fe, $e0, $00, $0e, $fe, $f0),
    ($00, $e0, $00, $e0, $00, $f0, $00, $f0 ), ($00, $e0, $1e, $fe, $00, $f0, $0e, $fe),
    ($00, $e0, $e0, $00, $00, $f0, $f0, $00 ), ($00, $e0, $fe, $1e, $00, $f0, $fe, $0e),
    ($00, $fe, $00, $fe, $00, $fe, $00, $fe ), ($00, $fe, $1e, $e0, $00, $fe, $0e, $f0),
    ($00, $fe, $e0, $1e, $00, $fe, $f0, $0e ), ($00, $fe, $fe, $00, $00, $fe, $fe, $00),
    ($0e, $0e, $0e, $0e, $f0, $f0, $f0, $f0 ), ($1e, $00, $00, $1e, $0e, $00, $00, $0e),
    ($1e, $00, $1e, $00, $0e, $00, $0e, $00 ), ($1e, $00, $e0, $fe, $0e, $00, $f0, $fe),
    ($1e, $00, $fe, $e0, $0e, $00, $fe, $f0 ), ($1e, $1e, $00, $00, $0e, $0e, $00, $00),


($1e, $1e, $1e, $1e, $0e, $0e, $0e, $0e ), ($1e, $1e, $e0, $e0, $0e, $0e, $f0, $f0),
    ($1e, $1e, $fe, $fe, $0e, $0e, $fe, $fe ), ($1e, $e0, $00, $fe, $0e, $f0, $00, $fe),
    ($1e, $e0, $1e, $e0, $0e, $f0, $0e, $f0 ), ($1e, $e0, $e0, $1e, $0e, $f0, $f0, $0e),
    ($1e, $e0, $fe, $00, $0e, $f0, $fe, $00 ), ($1e, $fe, $00, $e0, $0e, $fe, $00, $f0),
    ($1e, $fe, $1e, $fe, $0e, $fe, $0e, $fe ), ($1e, $fe, $e0, $00, $0e, $fe, $f0, $00),
    ($1e, $fe, $fe, $1e, $0e, $fe, $fe, $0e ), ($e0, $00, $00, $e0, $f0, $00, $00, $f0),
    ($e0, $00, $1e, $fe, $f0, $00, $0e, $fe ), ($e0, $00, $e0, $00, $f0, $00, $f0, $00),
    ($e0, $00, $fe, $1e, $f0, $00, $fe, $0e ), ($e0, $1e, $00, $fe, $f0, $0e, $00, $fe),
    ($e0, $1e, $1e, $e0, $f0, $0e, $0e, $f0 ), ($e0, $1e, $e0, $1e, $f0, $0e, $f0, $0e),
    ($e0, $1e, $fe, $00, $f0, $0e, $fe, $00 ), ($e0, $e0, $00, $00, $f0, $f0, $00, $00),
    ($e0, $e0, $1e, $1e, $f0, $f0, $0e, $0e ), ($e0, $e0, $fe, $fe, $f0, $f0, $fe, $fe),
    ($e0, $fe, $00, $1e, $f0, $fe, $00, $0e ), ($e0, $fe, $1e, $00, $f0, $fe, $0e, $00),
    ($e0, $fe, $e0, $fe, $f0, $fe, $f0, $fe ), ($e0, $fe, $fe, $e0, $f0, $fe, $fe, $f0),
    ($fe, $00, $00, $fe, $fe, $00, $00, $fe ), ($fe, $00, $1e, $e0, $fe, $00, $0e, $f0),
    ($fe, $00, $e0, $1e, $fe, $00, $f0, $0e ), ($fe, $00, $fe, $00, $fe, $00, $fe, $00),
    ($fe, $1e, $00, $e0, $fe, $0e, $00, $f0 ), ($fe, $1e, $1e, $fe, $fe, $0e, $0e, $fe),
    ($fe, $1e, $e0, $00, $fe, $0e, $f0, $00 ), ($fe, $1e, $fe, $1e, $fe, $0e, $fe, $0e),
    ($fe, $e0, $00, $1e, $fe, $f0, $00, $0e ), ($fe, $e0, $1e, $00, $fe, $f0, $0e, $00),
    ($fe, $e0, $e0, $fe, $fe, $f0, $f0, $fe ), ($fe, $e0, $fe, $e0, $fe, $f0, $fe, $f0),
    ($fe, $fe, $00, $00, $fe, $fe, $00, $00 ), ($fe, $fe, $1e, $1e, $fe, $fe, $0e, $0e),
    ($fe, $fe, $e0, $e0, $fe, $fe, $f0, $f0 ), ($fe, $fe, $fe, $fe, $fe, $fe, $fe, $fe));
var
    selftest_failed: PChar;

type
  P_tripledes_ctx = ^_tripledes_ctx;
  _tripledes_ctx = record
    encrypt_subkeys: array [0..95] of DWORD;
    decrypt_subkeys: array [0..95] of DWORD;
  end;

  P_des_ctx = ^_des_ctx;
  _des_ctx = record
    encrypt_subkeys: array [0..31] of DWORD;
    decrypt_subkeys: array [0..31] of DWORD;
  end;

  function working_memcmp( const a, b: PChar; n: DWORD): Integer;
  procedure des_key_schedule(const rawkey: PByte; subkey: PDWORD);
  function des_setkey(ctx: P_des_ctx; const key: PByte): Integer;
  function des_ecb_crypt(ctx: P_des_ctx; const _from: PByte; _to: PByte; mode: Integer): Integer;
  function tripledes_set2keys(ctx: P_tripledes_ctx; key1, key2: PByte): Integer;
  function tripledes_set3keys(ctx: P_tripledes_ctx; key1, key2, key3: PByte): Integer;
  procedure tripledes_ecb_crypt(ctx: P_tripledes_ctx; const _from: PByte; _to: PByte; mode: Integer);
  function is_weak_key(const key: PByte): Integer;

  function selftest(): string;
  function selftest3(): string;

  procedure DO_PERMUTATION(var a, temp, b: DWORD; const offset, mask: DWORD);
  procedure INITIAL_PERMUTATION(var left, temp, right: DWORD);
  procedure FINAL_PERMUTATION(var left, temp, right: DWORD);
  procedure DES_ROUND(var _from, _to, work: DWORD; var subkey: PDWORD);
  procedure READ_64BIT_DATA(var data: PChar; var left, right: DWORD);
  procedure WRITE_64BIT_DATA(var data: PChar; left, right: DWORD);

implementation

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;

procedure des_key_schedule(const rawkey: PByte; subkey: PDWORD);
var
  left, right, work: DWORD;
  round: Integer;
  _rawkey: PChar;
begin
  _rawkey := PChar(rawkey);
  READ_64BIT_DATA (_rawkey, left, right);

  DO_PERMUTATION (right, work, left, 4, $0f0f0f0f);
  DO_PERMUTATION (right, work, left, 0, $10101010);

  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;

  data := PChar(_from);
  READ_64BIT_DATA (data, left, right);
  INITIAL_PERMUTATION (left, work, right);

  DES_ROUND(right, left, work, keys); DES_ROUND(left, right, work, keys);
  DES_ROUND(right, left, work, keys); DES_ROUND(left, right, work, keys);
  DES_ROUND(right, left, work, keys); DES_ROUND(left, right, work, keys);


DES_ROUND(right, left, work, keys); DES_ROUND(left, right, work, keys);