ctdcrypt.pas

Citadel v.1.6 Full Sources

unit ctdCrypt;

interface

uses Windows, SysUtils;

procedure CtdEncrypt(Password: AnsiString; Buffer: Pointer; BufLen: Integer);
procedure CtdDecrypt(Password: AnsiString; Buffer: Pointer; BufLen: Integer);
procedure CtdEncrypt2(Password: AnsiString; BufferOrg, BufferDst: Pointer;
  BufLen: Integer);
procedure CtdDecrypt2(Password: AnsiString; BufferOrg, BufferDst: Pointer;
  BufLen: Integer);

implementation

type
  TDWordArray = array[0..32767] of DWord;
  PDWordArray = ^TDWordArray;
  
  StKey = record
    v: array[0..383] of DWord;
    i,
    j,
    t3: Byte;
  end;

  StGp8 = packed record
    Coef: array[0..7, 0..3] of Byte;
    x: array[0..3] of DWord;
  end;

procedure ExpandKey(Input: PByteArray; InputSize: Integer; var IntState: StGp8);
var
  i: Integer;
  p: PByteArray;
  Counter: Byte;
begin
  Assert((InputSize >= 2) and (InputSize <= 48));

  p := @IntState;
  Move(Input^, p^, InputSize);
  for i := InputSize to 47 do
    p[i] := p[i - InputSize] + p[i - InputSize + 1];
  Counter := 1;
  for i := 0 to 31 do
  begin
    if p[i] = 0 then
    begin
      p[i] := Counter;
      Inc(Counter);
    end;
  end;
end;

procedure gp8(Output: PDWordArray; var IntState: StGp8);
var
  y1,
  y2,
  x_1,
  x_2,
  x_3,
  x_4: DWord;
  NewX: array[0..3] of DWord;
  i,
  i2: Integer;
begin
  i := 0;
  repeat
    i2  := i shr 1;
    x_1 := IntState.x[i2] shr 16;
    x_2 := x_1 * x_1;
    x_3 := x_2 * x_1;
    x_4 := x_3 * x_1;
    y1  := IntState.Coef[i, 0] * x_4 +
           IntState.Coef[i, 1] * x_3 +
           IntState.Coef[i, 2] * x_2 +
           IntState.Coef[i, 3] * x_1 + 1;

    x_1 := IntState.x[i2] and $FFFF;
    x_2 := x_1 * x_1;
    x_3 := x_2 * x_1;
    x_4 := x_3 * x_1;

    y2  := IntState.Coef[i + 1, 0] * x_4 +
           IntState.Coef[i + 1, 1] * x_3 +
           IntState.Coef[i + 1, 2] * x_2 +
           IntState.Coef[i + 1, 3] * x_1 + 1;

    Output[i2] := (y1 shl 16) or (y2 and $FFFF);
    NewX  [i2] := (y1 and $FFFF0000) or (y2 shr 16);

    Inc(i, 2);
  until i = 8;

  IntState.x[0] := (NewX[0] shr 16) or (NewX[3] shl 16);
  IntState.x[1] := (NewX[0] shl 16) or (NewX[1] shr 16);
  IntState.x[2] := (NewX[1] shl 16) or (NewX[2] shr 16);
  IntState.x[3] := (NewX[2] shl 16) or (NewX[3] shr 16);
end;

procedure InitKey(Inp: PByteArray; InpSize: Integer; var kt: StKey;
  var IntState: StGp8);
var
  Odd: DWord;
  t: array[0..3] of DWord;
  i,
  j: Integer;
  aux: PDWordArray;
begin
  {$ifndef CtdDoTrial}
  for i := 0 to InpSize-1 do
    Inp[i] := Inp[i] xor $A5;
  {$endif CtdDoTrial}

  aux := @kt.v;
  ExpandKey(Inp, InpSize, IntState);
  for i := 0 to 7 do
    gp8(@t, IntState);
  for i := 0 to 11 do
  begin
    for j := 0 to 7 do
      gp8(@aux[(i * 32) + (j * 4)], IntState);
    gp8(@t, IntState);
  end;
  gp8(@t, IntState);
  kt.i      := t[3] shr 24;
  kt.j      := t[3] shr 16;
  kt.t3     := t[3] shr 8;
  Odd       := t[3] and $7F;
  kt.v[Odd] := kt.v[Odd] or $01;
end;

procedure Encrypt(Buf: PDWord; BufLen: DWord; var SKey: StKey);
var
  i,
  j: Byte;
  t1,
  t2,
  t3,
  k,
  t,
  Limit: DWord;
  w: PDWord;
  v: PDWordArray;
begin
  Assert(BufLen mod 4 = 0);

  i  := SKey.i;
  j  := SKey.j;
  t3 := SKey.t3;
  v  := @SKey.v;
  w  := Buf;
  Limit := DWord(Buf) + BufLen;
  while DWord(w) < Limit do
  begin
    t1 := v[128 + j];
    Inc(j, t3);
    t  := v[i];
    t2 := v[128 + j];
    Inc(i);
    t3 := t2 + t;
    v[128 + j] := t3;
    Inc(j, t2);
    k  := t1 + t2;
    Inc(w^, k);
    Inc(w);
  end;
end;

procedure Decrypt(Buf: PDWord; BufLen: DWord; var SKey: StKey);
var
  i,
  j: Byte;
  t1,
  t2,
  t3,
  k,
  t,
  Limit: DWord;
  w: PDWord;
  v: PDWordArray;
begin
  Assert(BufLen mod 4 = 0);

  i     := SKey.i;
  j     := SKey.j;
  t3    := SKey.t3;
  v     := @SKey.v;
  w     := Buf;
  Limit := DWord(Buf) + BufLen;
  while DWord(w) < Limit do
  begin
    t1 := v[128 + j];
    Inc(j, t3);
    t  := v[i];
    t2 := v[128 + j];
    Inc(i);
    t3 := t2 + t;
    v[128 + j] := t3;
    Inc(j, t2);
    k  := t1 + t2;
    Dec(w^, k);
    Inc(w);
  end;
end;

procedure Encrypt2(BufOrg, BufDst: PDWord; BufLen: DWord; var SKey: StKey);
var
  i,
  j: Byte;
  t1,
  t2,
  t3,
  k,
  t,
  Limit: DWord;
  wOrg,
  wDst: PDWord;
  v: PDWordArray;
begin
  Assert(BufLen mod 4 = 0);

  i     := SKey.i;
  j     := SKey.j;
  t3    := SKey.t3;
  v     := @SKey.v;
  wOrg  := BufOrg;
  wDst  := BufDst;
  Limit := DWord(BufOrg) + BufLen;
  while DWord(wOrg) < Limit do
  begin
    t1 := v[128 + j];
    Inc(j, t3);
    t  := v[i];
    t2 := v[128 + j];
    Inc(i);
    t3 := t2 + t;
    v[128 + j] := t3;
    Inc(j, t2);
    k  := t1 + t2;
    wDst^ := wOrg^ + k;
    Inc(wOrg);
    Inc(wDst);
  end;
end;

procedure Decrypt2(BufOrg, BufDst: PDWord; BufLen: DWord; var SKey: StKey);
var
  i,
  j: Byte;
  t1,
  t2,
  t3,
  k,
  t,
  Limit: DWord;
  wOrg,
  wDst: PDWord;
  v: PDWordArray;
begin
  Assert(BufLen mod 4 = 0);

  i     := SKey.i;
  j     := SKey.j;
  t3    := SKey.t3;
  v     := @SKey.v;
  wOrg  := BufOrg;
  wDst  := BufDst;
  Limit := DWord(BufOrg) + BufLen;
  while DWord(wOrg) < Limit do
  begin
    t1 := v[128 + j];
    Inc(j, t3);
    t  := v[i];
    t2 := v[128 + j];
    Inc(i);
    t3 := t2 + t;
    v[128 + j] := t3;
    Inc(j, t2);
    k  := t1 + t2;
    wDst^ := wOrg^ - k;
    Inc(wOrg);
    Inc(wDst);
  end;
end;

procedure CtdEncrypt(Password: AnsiString; Buffer: Pointer; BufLen: Integer);
var
  rl,
  i: Integer;
  kt: StKey;
  IntState: StGp8;
begin
  InitKey(@Password[1], Length(Password), kt, IntState);
  Encrypt(Buffer, (BufLen div 4) * 4, kt);
  rl := BufLen mod 4;
  if rl <> 0 then
  begin
    for i := 0 to rl-1 do
      PByteArray(Buffer)[BufLen - rl + i] :=
        PByteArray(Buffer)[BufLen - rl + i] xor ($5B + i * 21);
  end;
end;

procedure CtdDecrypt(Password: AnsiString; Buffer: Pointer; BufLen: Integer);
var
  rl,
  i: Integer;
  kt: StKey;
  IntState: StGp8;
begin
  InitKey(@Password[1], Length(Password), kt, IntState);
  Decrypt(Buffer, (BufLen div 4) * 4, kt);
  rl := BufLen mod 4;
  if rl <> 0 then
  begin
    for i := 0 to rl-1 do
      PByteArray(Buffer)[BufLen - rl + i] :=
        PByteArray(Buffer)[BufLen - rl + i] xor ($5B + i * 21);
  end;
end;

procedure CtdEncrypt2(Password: AnsiString; BufferOrg, BufferDst: Pointer;
  BufLen: Integer);
var
  rl,
  i: Integer;
  kt: StKey;
  IntState: StGp8;
begin
  InitKey(@Password[1], Length(Password), kt, IntState);
  Encrypt2(BufferOrg, BufferDst, (BufLen div 4) * 4, kt);
  rl := BufLen mod 4;
  if rl <> 0 then
  begin
    for i := 0 to rl-1 do
      PByteArray(BufferDst)[BufLen - rl + i] :=
        PByteArray(BufferOrg)[BufLen - rl + i] xor ($5B + i * 21);
  end;
end;

procedure CtdDecrypt2(Password: AnsiString; BufferOrg, BufferDst: Pointer;
  BufLen: Integer);
var
  rl,
  i: Integer;
  kt: StKey;
  IntState: StGp8;
begin
  InitKey(@Password[1], Length(Password), kt, IntState);
  Decrypt2(BufferOrg, BufferDst, (BufLen div 4) * 4, kt);
  rl := BufLen mod 4;
  if rl <> 0 then
  begin
    for i := 0 to rl-1 do
      PByteArray(BufferDst)[BufLen - rl + i] :=
        PByteArray(BufferOrg)[BufLen - rl + i] xor ($5B + i * 21);
  end;
end;

end.