encryption.pas

NTLM 的Delphi 实现, 里面包含加密算法.

  a := a + (F(b, c, d) + x);
  a := rol(a, s);
end;

procedure TEncryption.GG(var a: LongWord; b, c, d, x, s: LongWord);
begin
  a := a + G(b, c, d) + x + $5a827999;
  a := rol(a, s);
end;

procedure TEncryption.HH(var a: LongWord; b, c, d, x, s: LongWord);
begin
  a := a + H(b, c, d) + x + $6ed9eba1;
  a := rol(a, s);
end;

procedure TEncryption.MDInit(context: PMD4Ctx);
begin
  context^.count[0] := 0;
  context^.count[1] := 0;
  context^.state[0] := $67452301;
  context^.state[1] := $efcdab89;
  context^.state[2] := $98badcfe;
  context^.state[3] := $10325476;
end;

procedure TEncryption.MDEncode(output, input: Pointer; len: LongWord);
var
  i, j: LongWord;
begin
  i := 0; j := 0;
  while j < len do
  begin
    PByteArray(output)^[j] := (PDWordArray(input)^[i] and $ff);
    PByteArray(output)^[j + 1] := ((PDWordArray(input)^[i] shr 8) and $ff);
    PByteArray(output)^[j + 2] := ((PDWordArray(input)^[i] shr 16) and $ff);
    PByteArray(output)^[j + 3] := ((PDWordArray(input)^[i] shr 24) and $ff);
    Inc(i); Inc(j, 4);
  end;
end;

procedure TEncryption.MDDecode(output, input: Pointer; len: LongWord);
var
  i, j: LongWord;
begin
  i := 0; j := 0;
  while j < len do
  begin
    PDWordArray(output)^[i] := PByteArray(input)^[j] or (PByteArray(input)^[j + 1] shl 8) or (PByteArray(input)^[j + 2] shl 16) or (PByteArray(input)^[j + 3] shl 24);
    Inc(i); Inc(j, 4);
  end;
end;

procedure TEncryption.MD4Transform (var state: array of LongWord; block: Pointer);
var
  a, b, c, d: LongWord;
  x: array[0..15] of LongWord;
begin
  a := state[0]; b := state[1]; c := state[2]; d := state[3];
  MDDecode(@x, block, 64);

  FF (a, b, c, d, x[ 0], S11);
  FF (d, a, b, c, x[ 1], S12);
  FF (c, d, a, b, x[ 2], S13);
  FF (b, c, d, a, x[ 3], S14);
  FF (a, b, c, d, x[ 4], S11);
  FF (d, a, b, c, x[ 5], S12);
  FF (c, d, a, b, x[ 6], S13);
  FF (b, c, d, a, x[ 7], S14);
  FF (a, b, c, d, x[ 8], S11);
  FF (d, a, b, c, x[ 9], S12);
  FF (c, d, a, b, x[10], S13);
  FF (b, c, d, a, x[11], S14);
  FF (a, b, c, d, x[12], S11);
  FF (d, a, b, c, x[13], S12);
  FF (c, d, a, b, x[14], S13);
  FF (b, c, d, a, x[15], S14);

  GG (a, b, c, d, x[ 0], S21);
  GG (d, a, b, c, x[ 4], S22);
  GG (c, d, a, b, x[ 8], S23);
  GG (b, c, d, a, x[12], S24);
  GG (a, b, c, d, x[ 1], S21);
  GG (d, a, b, c, x[ 5], S22);
  GG (c, d, a, b, x[ 9], S23);
  GG (b, c, d, a, x[13], S24);
  GG (a, b, c, d, x[ 2], S21);
  GG (d, a, b, c, x[ 6], S22);
  GG (c, d, a, b, x[10], S23);
  GG (b, c, d, a, x[14], S24);
  GG (a, b, c, d, x[ 3], S21);
  GG (d, a, b, c, x[ 7], S22);
  GG (c, d, a, b, x[11], S23);
  GG (b, c, d, a, x[15], S24);

  HH (a, b, c, d, x[ 0], S31);
  HH (d, a, b, c, x[ 8], S32);
  HH (c, d, a, b, x[ 4], S33);
  HH (b, c, d, a, x[12], S34);
  HH (a, b, c, d, x[ 2], S31);
  HH (d, a, b, c, x[10], S32);
  HH (c, d, a, b, x[ 6], S33);
  HH (b, c, d, a, x[14], S34);
  HH (a, b, c, d, x[ 1], S31);
  HH (d, a, b, c, x[ 9], S32);
  HH (c, d, a, b, x[ 5], S33);
  HH (b, c, d, a, x[13], S34);
  HH (a, b, c, d, x[ 3], S31);
  HH (d, a, b, c, x[11], S32);
  HH (c, d, a, b, x[ 7], S33);
  HH (b, c, d, a, x[15], S34);

  state[0] := state[0] + a;
  state[1] := state[1] + b;
  state[2] := state[2] + c;
  state[3] := state[3] + d;
end;

procedure TEncryption.MDUpdate(context: PMD4Ctx; input: Pointer; inputLen: LongWord);
var
  i, index, partLen: LongWord;
begin
  index := (context^.count[0] shr 3) and $3F;

  context^.count[0] := context^.count[0] + inputLen shl 3;
  if (context^.count[0] < (inputLen shl 3)) then
    Inc(context^.count[1]);

  context^.count[1] := context^.count[1] + inputLen shr 29;
  partLen := 64 - index;

  if (inputLen >= partLen) then
  begin
    Move(input^, context^.buffer[index], partLen);
    MD4Transform(context^.state, @context^.buffer);
    i := partLen;
    while i + 63 < inputLen do
    begin
      MD4Transform(context^.state, Addr(PByteArray(input)^[i]));
      Inc(i, 64);
    end;
    index := 0;
  end
  else
    i := 0;
  Move(PByteArray(input)^[i], context^.buffer[index], inputLen - i);
end;

function TEncryption.MDFinal(context: PMD4Ctx): String;
var
  digest: array[0..15] of Char;
  bits: array[0..7] of Char;
  index, padLen: LongWord;
begin
  MDEncode(@bits, @context^.count, 8);

  index := (context^.count[0] shr 3) and $3f;
  if (index < 56) then
    padLen := 56 - index
  else
    padLen := 120 - index;

  MDUpdate(context, @MD_PADDING, padLen);

  MDUpdate(context, @bits, 8);
  MDEncode(@digest, @context^.state, 16);

  FillChar(context^, 0, SizeOf(TMD4Ctx));

  Result := Digest;
end;

function TEncryption.GetBit(var Data; Index: Byte): Byte;
var
  Bits: Array [0..7] of Byte absolute Data;
begin
  Dec( Index );
  if Bits[Index div 8] and ( 128 shr( Index mod 8 ) ) > 0 then
    GetBit := 1
  else
    GetBit := 0;
end;

procedure TEncryption.SetBit( var Data; Index, Value : Byte );
var
  Bits: Array [0..7] Of Byte absolute Data;
  Bit: Byte;
begin
  Dec( Index );
  Bit := 128 shr( Index mod 8 );
  case Value of
    0: Bits[Index div 8] := Bits[Index div 8] and ( not Bit );
    1: Bits[Index div 8] := Bits[Index div 8] or Bit;
  end;
end;

procedure TEncryption.DF( var FK );
var
  K : Array [1..48] Of Byte absolute FK;
  Temp1 : Array [1..48] Of Byte;
  Temp2 : Array [1..32] Of Byte;
  n, h, i, j, Row, Column : Integer;
begin
  for n:=1 to 48 do
    Temp1[n]:=FR[E[n]] xor K[n];
  for n:=1 to 8 do
  begin
    i := ( n - 1 ) * 6;
    j := ( n -1 ) * 4;
    Row := Temp1[i+1] * 2 + Temp1[i+6];
    Column := Temp1[i+2] * 8 + Temp1[i+3] * 4 + Temp1[i+4] * 2 + Temp1[i+5];
    for h := 1 to 4 Do
    begin
      case h of
        1: Temp2[j+h] := ( SBoxes[n,Row,Column] and 8 ) div 8;
        2: Temp2[j+h] := ( SBoxes[n,Row,Column] and 4 ) div 4;
        3: Temp2[j+h] := ( SBoxes[n,Row,Column] and 2 ) div 2;
        4: Temp2[j+h] := ( SBoxes[n,Row,Column] and 1 );
      end;
    end;
  end;
  for n := 1 to 32 do
    FfunctionResult[n] := Temp2[P[n]];
end;

procedure TEncryption.Shift( var SubKeyPart );
var
  SKP: Array [1..28] Of Byte absolute SubKeyPart;
  n, b: Byte;
begin
  b := SKP[1];
  for n := 1 to 27 do
    SKP[n] := SKP[n+1];
  SKP[28] := b;
end;

procedure TEncryption.SubKey( Round: Byte; var SubKey );
var
  SK : Array [1..48] of Byte absolute SubKey;
  n, b : Byte;
begin
  for n := 1 to ShiftTable[Round] do
  begin
    Shift( FC );
    Shift( FD );
  end;
  for n := 1 to 48 do
  begin
    b := PC_2[n];
    if b <= 28 then
      SK[n] := FC[b]
    else
      SK[n] := FD[b-28];
  end;
end;

procedure TEncryption.SetKeys;
var
 n: Byte;
 Key: Array [0..7] of Byte;
begin
  move( FKey[1], Key, 8 );
  for n := 1 to 28 do
  begin
    FC[n] := GetBit( Key, PC_1[n] );
    FD[n] := GetBit( Key, PC_1[n+28] );
  end;
  for n := 1 to 16 do
    SubKey( n,FRoundKeys[n] );
end;

procedure TEncryption.EncipherBlock;
var
  n, b, Round : Byte;
begin
  for n := 1 to 64 do
    FInputValue[n]:=GetBit( FSmallBuffer, n );
  for n := 1 to 64 do
    if n <= 32 then
      FL[n] := FInputValue[IP[n]]
    else
      FR[n-32] := FInputValue[IP[n]];
  for Round := 1 to 16 do
  begin
    DF( FRoundKeys[Round] );
    For n := 1 to 32 do
      FfunctionResult[n] := FfunctionResult[n] xor FL[n];
    FL := FR;
    FR := FfunctionResult;
  end;
  for n := 1 to 64 do
  begin
    b := InvIP[n];
    if b <= 32 then
      FOutputValue[n] := FR[b]
    else
      FOutputValue[n] := FL[b-32];
  end;
  for n := 1 to 64 do
    SetBit( FSmallBuffer, n, FOutputValue[n] );
end;

function TEncryption.DesEcbEncrypt(AKey: String; AData: Array of byte): String;
var
  i, j, t, bit: Integer;
begin
  SetLength( FKey, 8 );
  FKey[1] := AKey[1];
  FKey[2] := char( ( ( Byte( AKey[1] ) shl 7 ) and $FF ) or ( Byte( AKey[2] ) shr 1 ) );
  FKey[3] := char( ( ( Byte( AKey[2] ) shl 6 ) and $FF ) or ( Byte( AKey[3] ) shr 2 ) );
  FKey[4] := char( ( ( Byte( AKey[3] ) shl 5 ) and $FF ) or ( Byte( AKey[4] ) shr 3 ) );
  FKey[5] := char( ( ( Byte( AKey[4] ) shl 4 ) and $FF ) or ( Byte( AKey[5] ) shr 4 ) );
  FKey[6] := char( ( ( Byte( AKey[5] ) shl 3 ) and $FF ) or ( Byte( AKey[6] ) shr 5 ) );
  FKey[7] := char( ( ( Byte( AKey[6] ) shl 2 ) and $FF ) or ( Byte( AKey[7] ) shr 6 ) );
  FKey[8] := char( ( ( Byte( AKey[7] ) shl 1 ) and $FF ) );

  for i := 1 to 8 do
  begin
    for j := 1 to 7 do
    begin
      bit := 0;
      t := Byte( Fkey[i] ) shl j;
      bit :=( t xor bit) and $1;
    end;
    Fkey[i] := char( ( Byte( Fkey[i] ) and $FE ) or bit );
  end;
  SetKeys;

  SetLength( Result, 8 );
  move( AData, FSmallBuffer, 8 );
  EncipherBlock;
  move( FSmallBuffer, Result[1], 8 );
end;

end.