unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
(*
  typedef unsigned short int UINT2;
  typedef unsigned long int UINT4;

  typedef struct {
    UINT4 subkeys[32];                                             /* subkeys */
    UINT4 iv[2];                                       /* initializing vector */
    UINT4 originalIV[2];                        /* for restarting the context */
    int encrypt;                                               /* encrypt flag */
  } DES_CBC_CTX;

  typedef struct {
    UINT4 subkeys[32];                                             /* subkeys */
    UINT4 iv[2];                                       /* initializing vector */
    UINT4 inputWhitener[2];                                 /* input whitener */
    UINT4 outputWhitener[2];                               /* output whitener */
    UINT4 originalIV[2];                        /* for restarting the context */
    int encrypt;                                              /* encrypt flag */
  } DESX_CBC_CTX;

  typedef struct {
    UINT4 subkeys[3][32];                     /* subkeys for three operations */
    UINT4 iv[2];                                       /* initializing vector */
    UINT4 originalIV[2];                        /* for restarting the context */
    int encrypt;                                              /* encrypt flag */
  } DES3_CBC_CTX;
*)
  UINT2 = Smallint;
  UINT4 = Longint;

  DES_CBC_CTX = packed record
    subkeys: array[1..32] of UINT4;
    iv: array[1..2] of UINT4;
    originalIV: array[1..2] of UINT4;
    encrypt: Integer;
  end;

  DESX_CBC_CTX = packed record
    subkeys: array[1..32] of UINT4;
    iv: array[1..2] of UINT4;
    inputWhitener: array[1..2] of UINT4;
    outputWhitener: array[1..2] of UINT4;
    originalIV: array[1..2] of UINT4;
    encrypt: Integer;
  end;
  
  DES3_CBC_CTX = packed record
    subkeys: array[1..3, 1..32] of UINT4;
    iv: array[1..2] of UINT4;
    originalIV: array[1..2] of UINT4;
    encrypt: Integer;
  end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    Button2: TButton;
    Edit2: TEdit;
    Button3: TButton;
    Label1: TLabel;
    Edit3: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

function StrToHex(const S: String): String;
function HexToStr(const S: String): String;

{$L des.obj}

{
void DES_CBCInit(DES_CBC_CTX *, unsigned char *, unsigned char *, int);
int DES_CBCUpdate(DES_CBC_CTX *, unsigned char *, unsigned char *, unsigned int);
void DES_CBCRestart(DES_CBC_CTX *);

void DESX_CBCInit(DESX_CBC_CTX *, unsigned char *, unsigned char *, int);
int DESX_CBCUpdate(DESX_CBC_CTX *, unsigned char *, unsigned char *, unsigned int);
void DESX_CBCRestart(DESX_CBC_CTX *);

void DES3_CBCInit(DES3_CBC_CTX *, unsigned char *, unsigned char *, int);
int DES3_CBCUpdate(DES3_CBC_CTX *, unsigned char *, unsigned char *, unsigned int);
void DES3_CBCRestart(DES3_CBC_CTX *);
}

procedure DES_CBCInit(var ctx: DES_CBC_CTX; key: PChar; iv: PChar; encrypt: Integer); external;
function DES_CBCUpdate(var ctx: DES_CBC_CTX; output: PChar; input: PChar; len: Integer): Integer; external;
procedure DES_CBCRestart(var ctx: DES_CBC_CTX); external;

procedure DESX_CBCInit(var ctx: DESX_CBC_CTX; key: PChar; iv: PChar; encrypt: Integer); external;
function DESX_CBCUpdate(var ctx: DESX_CBC_CTX; output: PChar; input: PChar; len: Integer): Integer; external;
procedure DESX_CBCRestart(var ctx: DESX_CBC_CTX); external;

procedure DES3_CBCInit(var ctx: DES3_CBC_CTX; key: PChar; iv: PChar; encrypt: Integer); external;
function DES3_CBCUpdate(var ctx: DES3_CBC_CTX; output: PChar; input: PChar; len: Integer): Integer; external;
procedure DES3_CBCRestart(var ctx: DES3_CBC_CTX); external;

function EncryptStr(const S: String; const Key: String): String;
function DecryptStr(const S: String; const Key: String): String;

implementation

{$R *.dfm}

function StrToHex(const S: String): String;
var
  i, t: Integer;
begin
  SetLength(Result, Length(S)*2);
  for i := 1 to Length(S) do
  begin
    t := Ord(S[i]) and $0F;
    if t < 10 then
      Result[i*2] := Chr(Ord('0') + t)
    else
      Result[i*2] := Chr(Ord('A') + (t - 10));
    t := (Ord(S[i]) shr 4) and $0F;
    if t < 10 then
      Result[i*2 - 1] := Chr(Ord('0') + t)
    else
      Result[i*2 - 1] := Chr(Ord('A') + (t - 10));
  end;
end;

function HexToStr(const S: String): String;
var
  i: Integer;
  t: Byte;
begin
  SetLength(Result, Length(S) div 2);
  FillChar(PChar(Result)^, Length(Result), 0);
  for i := 1 to Length(S) div 2 * 2 do
  begin
    if (S[i] >= 'a') and (S[i] <= 'z') then
      t := Ord(S[i]) - Ord('a') + 10
    else if (S[i] >= 'A') and (S[i] <= 'Z') then
      t := Ord(S[i]) - Ord('A') + 10
    else if (S[i] >= '0') and (S[i] <= '9') then
      t := Ord(S[i]) - Ord('0')
    else
      t := 0;
    if i mod 2 <> 0 then t := t shl 4;
    Byte(Result[(i + 1) div 2]) :=
      Byte(Result[(i + 1) div 2]) or Byte(t);
  end;  
end;

function EncryptStr(const S: String; const Key: String): String;
var
  ctx: DES_CBC_CTX;
  t1, t2: String;
  len: Integer;
begin
  t1 := Key;
  t2 := Key;
  DES_CBCInit(ctx, PChar(t1), PChar(t2), 1);
  len := Length(S);
  len := (len + 7) div 8 * 8;
  SetLength(Result, len);
  DES_CBCUpdate(ctx, PChar(Result), PChar(S), len);
end;

function DecryptStr(const S: String; const Key: String): String;
var
  ctx: DES_CBC_CTX;
  t1, t2: String;
  len: Integer;
begin
  t1 := Key;
  t2 := Key;
  DES_CBCInit(ctx, PChar(t1), PChar(t2), 0);
  len := Length(S);
  len := (len + 7) div 8 * 8;
  SetLength(Result, len);
  DES_CBCUpdate(ctx, PChar(Result), PChar(S), len);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  t1, t2: String;
  s1, b: String;
begin
  t1 := Edit1.Text;
  t2 := Edit2.Text;
  t1 := t1 + StringOfChar(#0, (Length(t1) + 7) div 8 * 8 - Length(t1));
  s1 := EncryptStr(t2, t1);
  b := StrToHex(s1);
  Memo1.Text := b;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  s1, s2, b: String;
  t1: String;
begin
  b := Memo1.Text;
  t1 := Edit1.Text;
  t1 := t1 + StringOfChar(#0, (Length(t1) + 7) div 8 * 8 - Length(t1));
  s1 := HexToStr(b);
  s2 := DecryptStr(s1, t1);
  Edit3.Text := s2;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  s: String;
begin
  s := Edit1.Text;
  s := StrToHex(s);
  ShowMessage(s);
  s := HexToStr(s);
  ShowMessage(s);
end;

end.