hash.pas

说明：支持标准MD5、SHA1、Inno密码、QQ密码、Serv-U密码。 支持多线程。 支持进度保存、读取。

Unit Hash;

Interface

Uses Windows, SysUtils, Classes, Math;

{SHA1*******************************************************************************}
Type
  TSHA1Digest = Array[0..19] Of Byte;    { 160 bits - SHA-1 }
  TSHA1Context = Record                  { SHA-1 }
    sdHi: DWord;
    sdLo: DWord;
    sdIndex: DWord;
    sdHash: Array[0..4] Of DWord;
    sdBuf: Array[0..63] Of Byte;
  End;

Procedure SHA1Init(Var Context: TSHA1Context);
Procedure SHA1Update(Var Context: TSHA1Context; Const Buf; BufSize: Longint);
Procedure SHA1Final(Var Context: TSHA1Context; Var Digest: TSHA1Digest);

Procedure HashSHA1(Var Digest: TSHA1Digest; Const Buf; BufSize: Longint);
Function SHA1String(Const Str: String): TSHA1Digest;
Function SHA1Buffer(Const Buf; BufSize: Cardinal): TSHA1Digest;
Function SHA1Stream(Stream: TStream): TSHA1Digest;
Function SHA1File(Const FileName: String): TSHA1Digest;

Function SHA1Print(Digest: TSHA1Digest): String;
Function SHA1Match(D1, D2: TSHA1Digest): Boolean;
{MD5*******************************************************************************}
Type
  TMD5Digest = Array[0..15] Of Byte;     { 128 bits - MD5 }
  TMD5Context = Array[0..87] Of Byte;    { MD5 }

  TMD5ContextEx = Packed Record
    Count: Array[0..1] Of DWord;        {number of bits handled mod 2^64}
    State: Array[0..3] Of DWord;        {scratch buffer}
    Buf: Array[0..63] Of Byte;          {input buffer}
  End;

Procedure MD5Init(Var Context: TMD5Context);
Procedure MD5Update(Var Context: TMD5Context; Const Buf; BufSize: Longint);
Procedure MD5Final(Var Context: TMD5Context; Var Digest: TMD5Digest);

Procedure HashMD5(Var Digest: TMD5Digest; Const Buf; BufSize: Longint);
Function MD5String(Const Str: String): TMD5Digest;
Function MD5Buffer(Const Buf; BufSize: Cardinal): TMD5Digest;
Function MD5Stream(Stream: TStream): TMD5Digest;
Function MD5File(Const FileName: String): TMD5Digest;

Function MD5Print(Digest: TMD5Digest): String;
Function MD5Match(D1, D2: TMD5Digest): Boolean;

Function BufferToHex(Const Buf; BufSize: Cardinal): String;
Function HexToBuffer(Const Hex: String; Var Buf; BufSize: Cardinal): Boolean;
Function CompareBuffers(Const Buf1, Buf2; BufSize: Cardinal): Boolean;
Implementation

{Public}
Function RolX(I, C: DWord): DWord; Register;
Asm
  mov  ecx, edx         {get count to cl}
  rol  eax, cl          {rotate eax by cl}
End;

Function BufferToHex(Const Buf; BufSize: Cardinal): String;
Const
  Digits: Array[0..15] Of Char =
  ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
Var
  I: Longint;
Begin
  Result := '';
  For I := 0 To BufSize - 1 Do
    Result := Result + Digits[(TByteArray(Buf)[I] Shr 4) And $0F] + Digits[TByteArray(Buf)[I] And $0F];
  // Result := Result + IntToHex(TByteArray(Buf)[I], 2);
End;

Function HexToBuffer(Const Hex: String; Var Buf; BufSize: Cardinal): Boolean;
Var
  I, C: Integer;
  Str: String;
  Count: Integer;
Begin
  Result := False;
  Str := '';
  For I := 1 To Length(Hex) Do
    If UpCase(Hex[I]) In ['0'..'9', 'A'..'F'] Then
      Str := Str + Hex[I];

  FillChar(Buf, BufSize, #0);
  Count := Min(Length(Hex), BufSize);

  For I := 0 To Count - 1 Do
  Begin
    Val('$' + Copy(Str, (I Shl 1) + 1, 2), TByteArray(Buf)[I], C); {!!.01}
    If (C <> 0) Then
      Exit;
  End;

  Result := True;
End;

Function CompareBuffers(Const Buf1, Buf2; BufSize: Cardinal): Boolean;
Var
  I: Integer;
Begin
  Result := False;
  For I := 0 To Pred(BufSize) Do
  Begin
    Result := TByteArray(Buf1)[I] = TByteArray(Buf2)[I];
    If Not Result Then
      Break;
  End;
End;

{SHA1}
Const
  SHA1_A = DWord($67452301);
  SHA1_B = DWord($EFCDAB89);
  SHA1_C = DWord($98BADCFE);
  SHA1_D = DWord($10325476);
  SHA1_E = DWord($C3D2E1F0);

  SHA1_K1 = DWord($5A827999);
  SHA1_K2 = DWord($6ED9EBA1);
  SHA1_K3 = DWord($8F1BBCDC);
  SHA1_K4 = DWord($CA62C1D6);

  LBMASK_HI = DWord($FF0000);
  LBMASK_LO = DWord($FF00);

Function SHA1SwapByteOrder(n: DWord): DWord;
Begin
  n := (n Shr 24) Or ((n Shr 8) And LBMASK_LO)
    Or ((n Shl 8) And LBMASK_HI) Or (n Shl 24);
  Result := n;
End;

Procedure SHA1Hash(Var Context: TSHA1Context);
Var
  A: DWord;
  B: DWord;
  C: DWord;
  D: DWord;
  E: DWord;

  X: DWord;
  W: Array[0..79] Of DWord;

  I: Longint;
Begin
  With Context Do
  Begin
    sdIndex := 0;
    Move(sdBuf, W, SizeOf(W));

    For I := 0 To 15 Do
      W[I] := SHA1SwapByteOrder(W[I]);

    For I := 16 To 79 Do
      W[I] := RolX(W[I - 3] Xor W[I - 8] Xor W[I - 14] Xor W[I - 16], 1);

    A := sdHash[0];
    B := sdHash[1];
    C := sdHash[2];
    D := sdHash[3];
    E := sdHash[4];

    For I := 0 To 19 Do
    Begin
      X := RolX(A, 5) + (D Xor (B And (C Xor D))) + E + W[I] + SHA1_K1;
      E := D;
      D := C;
      C := RolX(B, 30);
      B := A;
      A := X;
    End;

    For I := 20 To 39 Do
    Begin
      X := RolX(A, 5) + (B Xor C Xor D) + E + W[I] + SHA1_K2;
      E := D;
      D := C;
      C := RolX(B, 30);
      B := A;
      A := X;
    End;

    For I := 40 To 59 Do
    Begin
      X := RolX(A, 5) + ((B And C) Or (D And (B Or C))) + E + W[I] + SHA1_K3;
      E := D;
      D := C;
      C := RolX(B, 30);
      B := A;
      A := X;
    End;

    For I := 60 To 79 Do
    Begin
      X := RolX(A, 5) + (B Xor C Xor D) + E + W[I] + SHA1_K4;
      E := D;
      D := C;
      C := RolX(B, 30);
      B := A;
      A := X;
    End;

    sdHash[0] := sdHash[0] + A;
    sdHash[1] := sdHash[1] + B;
    sdHash[2] := sdHash[2] + C;
    sdHash[3] := sdHash[3] + D;
    sdHash[4] := sdHash[4] + E;

    FillChar(W, SizeOf(W), $00);
    FillChar(sdBuf, SizeOf(sdBuf), $00);
  End;
End;

Procedure SHA1Clear(Var Context: TSHA1Context);
Begin
  FillChar(Context, SizeOf(Context), $00);
End;

Procedure SHA1UpdateLen(Var Context: TSHA1Context; Len: DWord);
Begin
  Inc(Context.sdLo, (Len Shl 3));
  If Context.sdLo < (Len Shl 3) Then
    Inc(Context.sdHi);
  Inc(Context.sdHi, Len Shr 29);
End;

Procedure SHA1Init(Var Context: TSHA1Context);
Begin
  SHA1Clear(Context);
  Context.sdHash[0] := SHA1_A;
  Context.sdHash[1] := SHA1_B;
  Context.sdHash[2] := SHA1_C;
  Context.sdHash[3] := SHA1_D;
  Context.sdHash[4] := SHA1_E;
End;

Procedure SHA1Update(Var Context: TSHA1Context; Const Buf; BufSize: Longint);
Var
  PBuf: ^Byte;
Begin
  With Context Do
  Begin
    SHA1UpdateLen(Context, BufSize);
    PBuf := @Buf;
    While BufSize > 0 Do
    Begin
      If (SizeOf(sdBuf) - sdIndex) <= DWord(BufSize) Then
      Begin
        Move(PBuf^, sdBuf[sdIndex], SizeOf(sdBuf) - sdIndex);
        Dec(BufSize, SizeOf(sdBuf) - sdIndex);
        Inc(PBuf, SizeOf(sdBuf) - sdIndex);
        SHA1Hash(Context);
      End Else
      Begin
        Move(PBuf^, sdBuf[sdIndex], BufSize);
        Inc(sdIndex, BufSize);
        BufSize := 0;
      End;
    End;
  End;
End;

Procedure SHA1Final(Var Context: TSHA1Context; Var Digest: TSHA1Digest);
Begin
  With Context Do
  Begin
    sdBuf[sdIndex] := $80;

    If sdIndex >= 56 Then
      SHA1Hash(Context);

    PDWord(@sdBuf[56])^ := SHA1SwapByteOrder(sdHi);
    PDWord(@sdBuf[60])^ := SHA1SwapByteOrder(sdLo);

    SHA1Hash(Context);

    sdHash[0] := SHA1SwapByteOrder(sdHash[0]);
    sdHash[1] := SHA1SwapByteOrder(sdHash[1]);
    sdHash[2] := SHA1SwapByteOrder(sdHash[2]);
    sdHash[3] := SHA1SwapByteOrder(sdHash[3]);
    sdHash[4] := SHA1SwapByteOrder(sdHash[4]);

    Move(sdHash, Digest, SizeOf(Digest));
    SHA1Clear(Context);
  End;
End;

Procedure HashSHA1(Var Digest: TSHA1Digest; Const Buf; BufSize: Longint);
Var
  Context: TSHA1Context;
Begin
  SHA1Init(Context);
  SHA1Update(Context, Buf, BufSize);
  SHA1Final(Context, Digest);
End;

Function SHA1String(Const Str: String): TSHA1Digest;
Begin
  HashSHA1(Result, Str[1], Length(Str));
End;

Function SHA1Buffer(Const Buf; BufSize: Cardinal): TSHA1Digest;
Begin
  HashSHA1(Result, Buf, BufSize);
End;

Function SHA1Stream(Stream: TStream): TSHA1Digest;
Var
  Context: TSHA1Context;
  BufSize: Integer;
  FBuf: Array[0..1023] Of Byte;
Begin
  Stream.Position := 0;
  SHA1Init(Context);
  BufSize := Stream.Read(FBuf, SizeOf(FBuf));
  While (BufSize > 0) Do
  Begin
    SHA1Update(Context, FBuf, BufSize);
    BufSize := Stream.Read(FBuf, SizeOf(FBuf));
  End;
  SHA1Final(Context, Result);
End;