+ sha1 unit by Sergei Gorelkin, resolves #14604

git-svn-id: trunk@13727 -

.gitattributes

@@ -2595,6 +2595,7 @@ packages/hash/fpmake.pp svneol=native#text/plain
 packages/hash/src/crc.pas svneol=native#text/plain
 packages/hash/src/md5.pp svneol=native#text/plain
 packages/hash/src/ntlm.pas svneol=native#text/plain
+packages/hash/src/sha1.pp svneol=native#text/plain
 packages/hash/src/unixcrypt.pas svneol=native#text/plain
 packages/hash/src/uuid.pas svneol=native#text/plain
 packages/hermes/Makefile svneol=native#text/plain
@@ -8061,6 +8062,7 @@ tests/test/packages/fcl-db/tdb6.pp svneol=native#text/plain
 tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
 tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/thtmlwriter.pp svneol=native#text/plain
+tests/test/packages/hash/sha1test.pp svneol=native#text/plain
 tests/test/packages/hash/tmdtest.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw10045.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw11142.pp svneol=native#text/plain

packages/hash/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/08/02]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/09/16]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@@ -267,178 +267,178 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(F
 override PACKAGE_NAME=hash
 override PACKAGE_VERSION=2.5.1
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid sha1  unixcrypt
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid sha1  unixcrypt
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid sha1  unixcrypt
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid sha1  unixcrypt
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid sha1  unixcrypt
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid sha1  unixcrypt
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid sha1  unixcrypt
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid sha1  unixcrypt
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=md5 crc ntlm uuid
+override TARGET_UNITS+=md5 crc ntlm uuid sha1
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_EXAMPLEDIRS+=examples

packages/hash/Makefile.fpc

@@ -7,7 +7,7 @@ name=hash
 version=2.5.1
 
 [target]
-units=md5 crc ntlm uuid
+units=md5 crc ntlm uuid sha1
 units_linux=unixcrypt
 exampledirs=examples
 

packages/hash/fpmake.pp

@@ -26,6 +26,7 @@ begin
 
     P.Version:='2.2.2-0';
     T:=P.Targets.AddUnit('src/md5.pp');
+    T:=P.Targets.AddUnit('src/sha1.pp');
     T:=P.Targets.AddUnit('src/crc.pas');
     T:=P.Targets.AddUnit('src/ntlm.pas');
     T:=P.Targets.AddUnit('src/uuid.pas');

packages/hash/src/sha1.pp

@@ -0,0 +1,305 @@
+{
+    This file is part of the Free Pascal packages.
+    Copyright (c) 2009 by the Free Pascal development team
+
+    Implements a SHA-1 digest algorithm (RFC 3174)
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit sha1;
+{$mode objfpc}{$h+}
+
+interface
+
+type
+  TSHA1Digest = array[0..19] of Byte;
+  
+  TSHA1Context = record
+    State: array[0..4] of Cardinal;
+    Buffer: array[0..63] of Byte;
+    BufCnt: PtrUInt;   { in current block, i.e. in range of 0..63 }
+    Length: QWord;     { total count of bytes processed }
+  end;
+
+{ core }  
+procedure SHA1Init(var ctx: TSHA1Context);
+procedure SHA1Update(var ctx: TSHA1Context; const Buf; BufLen: PtrUInt);
+procedure SHA1Final(var ctx: TSHA1Context; var Digest: TSHA1Digest);
+
+{ auxiliary }
+function SHA1String(const S: String): TSHA1Digest;
+function SHA1Buffer(const Buf; BufLen: PtrUInt): TSHA1Digest;
+function SHA1File(const Filename: String; const Bufsize: PtrUInt = 1024): TSHA1Digest;
+
+{ helpers }
+function SHA1Print(const Digest: TSHA1Digest): String;
+function SHA1Match(const Digest1, Digest2: TSHA1Digest): Boolean;
+
+implementation
+
+// inverts the bytes of (Count div 4) cardinals from source to target.
+procedure Invert(Source, Dest: Pointer; Count: PtrUInt);
+var
+  S: PByte;
+  T: PCardinal;
+  I: PtrUInt;
+begin
+  S := Source;
+  T := Dest;
+  for I := 1 to (Count div 4) do
+  begin
+    T^ := S[3] or (S[2] shl 8) or (S[1] shl 16) or (S[0] shl 24);
+    inc(S,4);
+    inc(T);
+  end;
+end;
+
+procedure SHA1Init(var ctx: TSHA1Context);
+begin
+  FillChar(ctx, sizeof(TSHA1Context), 0);
+  ctx.State[0] := $67452301;
+  ctx.State[1] := $efcdab89;
+  ctx.State[2] := $98badcfe;
+  ctx.State[3] := $10325476;
+  ctx.State[4] := $c3d2e1f0;
+end;
+
+const
+  K20 = $5A827999;
+  K40 = $6ED9EBA1;
+  K60 = $8F1BBCDC;
+  K80 = $CA62C1D6;
+  
+procedure SHA1Transform(var ctx: TSHA1Context; Buf: Pointer);
+var
+  A, B, C, D, E, T: Cardinal;
+  Data: array[0..15] of Cardinal;
+  i: Integer;
+begin
+  A := ctx.State[0];
+  B := ctx.State[1];
+  C := ctx.State[2];
+  D := ctx.State[3];
+  E := ctx.State[4];
+  Invert(Buf, @Data, 64);
+{$push}
+{$r-,q-}
+  i := 0;
+  repeat
+    T := (B and C) or (not B and D) + K20 + E;
+    E := D;
+    D := C;
+    C := rordword(B, 2);
+    B := A;
+    A := T + roldword(A, 5) + Data[i and 15];
+    Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
+    Inc(i);
+  until i > 19;
+  
+  repeat
+    T := (B xor C xor D) + K40 + E;
+    E := D;
+    D := C;
+    C := rordword(B, 2);
+    B := A;
+    A := T + roldword(A, 5) + Data[i and 15];
+    Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
+    Inc(i);
+  until i > 39;
+  
+  repeat
+    T := (B and C) or (B and D) or (C and D) + K60 + E;
+    E := D;
+    D := C;
+    C := rordword(B, 2);
+    B := A;
+    A := T + roldword(A, 5) + Data[i and 15];
+    Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
+    Inc(i);
+  until i > 59;  
+  
+  repeat
+    T := (B xor C xor D) + K80 + E;
+    E := D;
+    D := C;
+    C := rordword(B, 2);
+    B := A;
+    A := T + roldword(A, 5) + Data[i and 15];
+    Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
+    Inc(i);
+  until i > 79;  
+
+  Inc(ctx.State[0], A);
+  Inc(ctx.State[1], B);
+  Inc(ctx.State[2], C);
+  Inc(ctx.State[3], D);
+  Inc(ctx.State[4], E);
+{$pop}
+  Inc(ctx.Length,64);
+end;
+
+procedure SHA1Update(var ctx: TSHA1Context; const Buf; BufLen: PtrUInt);
+var
+  Src: PByte;
+  Num: PtrUInt;
+begin
+  if BufLen = 0 then
+    Exit;
+
+  Src := @Buf;
+  Num := 0;
+
+  // 1. Transform existing data in buffer
+  if ctx.BufCnt > 0 then
+  begin
+    // 1.1 Try to fill buffer up to block size
+    Num := 64 - ctx.BufCnt;
+    if Num > BufLen then
+      Num := BufLen;
+
+    Move(Src^, ctx.Buffer[ctx.BufCnt], Num);
+    Inc(ctx.BufCnt, Num);
+    Inc(Src, Num);
+
+    // 1.2 If buffer is filled, transform it
+    if ctx.BufCnt = 64 then
+    begin
+      SHA1Transform(ctx, @ctx.Buffer);
+      ctx.BufCnt := 0;
+    end;
+  end;
+
+  // 2. Transform input data in 64-byte blocks
+  Num := BufLen - Num;
+  while Num >= 64 do
+  begin
+    SHA1Transform(ctx, Src);
+    Inc(Src, 64);
+    Dec(Num, 64);
+  end;
+
+  // 3. If there's less than 64 bytes left, add it to buffer
+  if Num > 0 then
+  begin
+    ctx.BufCnt := Num;
+    Move(Src^, ctx.Buffer, Num);
+  end;
+end;
+
+const
+  PADDING: array[0..63] of Byte = 
+    ($80,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+       0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+       0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+       0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
+    );
+
+procedure SHA1Final(var ctx: TSHA1Context; var Digest: TSHA1Digest);
+var
+  Length: QWord;
+  Pads: Cardinal;
+begin
+  // 1. Compute length of the whole stream in bits
+  Length := 8 * (ctx.Length + ctx.BufCnt);
+
+  // 2. Append padding bits
+  if ctx.BufCnt >= 56 then
+    Pads := 120 - ctx.BufCnt
+  else
+    Pads := 56 - ctx.BufCnt;
+  SHA1Update(ctx, PADDING, Pads);
+
+  // 3. Append length of the stream (8 bytes)
+  Length := NtoBE(Length);
+  SHA1Update(ctx, Length, 8);
+
+  // 4. Invert state to digest
+  Invert(@ctx.State, @Digest, 20);
+  FillChar(ctx, sizeof(TSHA1Context), 0);  
+end;
+
+function SHA1String(const S: String): TSHA1Digest;
+var
+  Context: TSHA1Context;
+begin
+  SHA1Init(Context);
+  SHA1Update(Context, PChar(S)^, length(S));
+  SHA1Final(Context, Result);
+end;
+
+function SHA1Buffer(const Buf; BufLen: PtrUInt): TSHA1Digest;
+var
+  Context: TSHA1Context;
+begin
+  SHA1Init(Context);
+  SHA1Update(Context, buf, buflen);
+  SHA1Final(Context, Result);
+end;
+
+function SHA1File(const Filename: String; const Bufsize: PtrUInt): TSHA1Digest;
+var
+  F: File;
+  Buf: Pchar;
+  Context: TSHA1Context;
+  Count: Cardinal;
+  ofm: Longint;
+begin
+  SHA1Init(Context);
+
+  Assign(F, Filename);
+  {$i-}
+  ofm := FileMode;
+  FileMode := 0;
+  Reset(F, 1);
+  {$i+}
+
+  if IOResult = 0 then
+  begin
+    GetMem(Buf, BufSize);
+    repeat
+      BlockRead(F, Buf^, Bufsize, Count);
+      if Count > 0 then
+        SHA1Update(Context, Buf^, Count);
+    until Count < BufSize;
+    FreeMem(Buf, BufSize);
+    Close(F);
+  end;
+
+  SHA1Final(Context, Result);
+  FileMode := ofm;
+end;
+
+const
+  HexTbl: array[0..15] of char='0123456789abcdef';     // lowercase
+
+function SHA1Print(const Digest: TSHA1Digest): String;
+var
+  I: Integer;
+  P: PChar;
+begin
+  SetLength(Result, 40);
+  P := Pointer(Result);
+  for I := 0 to 19 do
+  begin
+    P[0] := HexTbl[(Digest[i] shr 4) and 15];
+    P[1] := HexTbl[Digest[i] and 15];
+    Inc(P,2);
+  end;
+end;
+
+function SHA1Match(const Digest1, Digest2: TSHA1Digest): Boolean;
+var
+  A: array[0..4] of Cardinal absolute Digest1;
+  B: array[0..4] of Cardinal absolute Digest2;
+begin
+  Result := (A[0] = B[0]) and (A[1] = B[1]) and (A[2] = B[2]) and (A[3] = B[3]) and (A[4] = B[4]);
+end;
+
+end.

tests/test/packages/hash/sha1test.pp

@@ -0,0 +1,38 @@
+program sha1test;
+{$mode objfpc}{$h+}
+
+uses sha1;
+
+var
+  code: cardinal;
+  s, sdig: string;
+  i: integer;
+  ctx: TSHA1Context;
+  d: TSHA1Digest;
+begin
+  code := 0;
+  sdig := SHA1Print(SHA1String('abc'));
+  if sdig <> 'a9993e364706816aba3e25717850c26c9cd0d89d' then
+    code := code or 1;
+    
+  sdig := SHA1Print(SHA1String('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'));
+  if sdig <> '84983e441c3bd26ebaae4aa1f95129e5e54670f1' then
+    code := code or 2;
+
+  // SHA-1 of a million 'a' symbols
+  SetLength(s, 1000);
+  for i := 1 to 1000 do s[i] := 'a';
+  SHA1Init(ctx);
+  for i := 0 to 999 do
+    SHA1Update(ctx, PChar(s)^, 1000);
+  SHA1Final(ctx, d);
+  sdig := SHA1Print(d);
+  if sdig <> '34aa973cd4c4daa4f61eeb2bdbad27316534016f' then
+    code := code or 4;
+
+  if code = 0 then
+    writeln('Basic SHA-1 tests passed')
+  else
+    writeln('SHA-1 tests failed: ', code);
+  Halt(code);
+end.