{ *************************************************** * A binary compatible SHA1 implementation * * written by Dave Barton (davebarton@bigfoot.com) * *************************************************** * 160bit hash size * *************************************************** } unit SHA1; interface uses Windows,SysUtils; type TSHA1Digest = array[0..19] of byte; TSHA1Context = record Hash: array[0..4] of DWord; Hi, Lo: integer; Buffer: array[0..63] of byte; Index: integer; end; procedure SHA1Init(var Context: TSHA1Context); procedure SHA1Update(var Context: TSHA1Context; Buffer: pointer; Len: integer); procedure SHA1Final(var Context: TSHA1Context; var Digest: TSHA1Digest); function SHA1String(M: AnsiString): TSHA1Digest; function SHA1File(N: string): TSHA1Digest; function SHA1Print(Digest: TSHA1Digest): AnsiString; //****************************************************************************** implementation { $R- } function LRot16(X: Word; c: longint): Word; begin LRot16 := (X shl c) or (X shr (16 - c)); end; function RRot16(X: Word; c: longint): Word; begin RRot16 := (X shr c) or (X shl (16 - c)); end; function LRot32(X: DWord; c: longint): DWord; begin LRot32 := (X shl c) or (X shr (32 - c)); end; function RRot32(X: DWord; c: longint): DWord; begin RRot32 := (X shr c) or (X shl (32 - c)); end; //****************************************************************************** function F1(x, y, z: DWord): DWord; begin Result := z xor (x and (y xor z)); end; function F2(x, y, z: DWord): DWord; begin Result := x xor y xor z; end; function F3(x, y, z: DWord): DWord; begin Result := (x and y) or (z and (x or y)); end; //****************************************************************************** function RB(A: DWord): DWord; begin Result := (A shr 24) or ((A shr 8) and $FF00) or ((A shl 8) and $FF0000) or (A shl 24); end; procedure SHA1Compress(var Data: TSHA1Context); var A, B, C, D, E, T: DWord; W: array[0..79] of DWord; i: integer; begin Move(Data.Buffer, W, Sizeof(Data.Buffer)); for i := 0 to 15 do W[i] := RB(W[i]); for i := 16 to 79 do W[i] := LRot32(W[i - 3] xor W[i - 8] xor W[i - 14] xor W[i - 16], 1); A := Data.Hash[0]; B := Data.Hash[1]; C := Data.Hash[2]; D := Data.Hash[3]; E := Data.Hash[4]; for i := 0 to 19 do begin T := LRot32(A, 5) + F1(B, C, D) + E + W[i] + $5A827999; E := D; D := C; C := LRot32(B, 30); B := A; A := T; end; for i := 20 to 39 do begin T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + $6ED9EBA1; E := D; D := C; C := LRot32(B, 30); B := A; A := T; end; for i := 40 to 59 do begin T := LRot32(A, 5) + F3(B, C, D) + E + W[i] + $8F1BBCDC; E := D; D := C; C := LRot32(B, 30); B := A; A := T; end; for i := 60 to 79 do begin T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + $CA62C1D6; E := D; D := C; C := LRot32(B, 30); B := A; A := T; end; Data.Hash[0] := Data.Hash[0] + A; Data.Hash[1] := Data.Hash[1] + B; Data.Hash[2] := Data.Hash[2] + C; Data.Hash[3] := Data.Hash[3] + D; Data.Hash[4] := Data.Hash[4] + E; FillChar(W, Sizeof(W), 0); FillChar(Data.Buffer, Sizeof(Data.Buffer), 0); end; //****************************************************************************** procedure SHA1Init(var Context: TSHA1Context); begin Context.Hi := 0; Context.Lo := 0; Context.Index := 0; FillChar(Context.Buffer, Sizeof(Context.Buffer), 0); Context.Hash[0] := $67452301; Context.Hash[1] := $EFCDAB89; Context.Hash[2] := $98BADCFE; Context.Hash[3] := $10325476; Context.Hash[4] := $C3D2E1F0; end; //****************************************************************************** procedure SHA1UpdateLen(var Context: TSHA1Context; Len: integer); var i, k: integer; begin for k := 0 to 7 do begin i := Context.Lo; Inc(Context.Lo, Len); if Context.Lo < i then Inc(Context.Hi); end; end; //****************************************************************************** procedure SHA1Update(var Context: TSHA1Context; Buffer: pointer; Len: integer); type PByte = ^Byte; begin SHA1UpdateLen(Context, Len); while Len > 0 do begin Context.Buffer[Context.Index] := PByte(Buffer)^; Inc(PByte(Buffer)); Inc(Context.Index); Dec(Len); if Context.Index = 64 then begin Context.Index := 0; SHA1Compress(Context); end; end; end; //****************************************************************************** procedure SHA1Final(var Context: TSHA1Context; var Digest: TSHA1Digest); type PDWord = ^DWord; begin Context.Buffer[Context.Index] := $80; if Context.Index >= 56 then SHA1Compress(Context); PDWord(@Context.Buffer[56])^ := RB(Context.Hi); PDWord(@Context.Buffer[60])^ := RB(Context.Lo); SHA1Compress(Context); Context.Hash[0] := RB(Context.Hash[0]); Context.Hash[1] := RB(Context.Hash[1]); Context.Hash[2] := RB(Context.Hash[2]); Context.Hash[3] := RB(Context.Hash[3]); Context.Hash[4] := RB(Context.Hash[4]); Move(Context.Hash, Digest, Sizeof(Digest)); FillChar(Context, Sizeof(Context), 0); end; function SHA1String(M: AnsiString): TSHA1Digest; var Context: TSHA1Context; begin SHA1Init(Context); SHA1Update(Context, PAnsiChar(M), length(M)); SHA1Final(Context, Result); end; function SHA1File(N: string): TSHA1Digest; var FileHandle: THandle; MapHandle: THandle; ViewPointer: pointer; Context: TSHA1Context; begin SHA1Init(Context); FileHandle := CreateFile(pChar(N), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0); if FileHandle <> INVALID_HANDLE_VALUE then try MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil); if MapHandle <> 0 then try ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0); if ViewPointer <> nil then try SHA1Update(Context, ViewPointer, GetFileSize(FileHandle, nil)); finally UnmapViewOfFile(ViewPointer); end; finally CloseHandle(MapHandle); end; finally CloseHandle(FileHandle); end; SHA1Final(Context, Result); end; function SHA1Print(Digest: TSHA1Digest): AnsiString; var I: byte; const Digits: array[0..15] of AnsiChar = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'); begin Result := ''; for I := 0 to 19 do Result := Result + Digits[(Digest[I] shr 4) and $0F] + Digits[Digest[I] and $0F]; end; end.