summaryrefslogtreecommitdiff
path: root/packages/hash
diff options
context:
space:
mode:
authorflorian <florian@3ad0048d-3df7-0310-abae-a5850022a9f2>2009-09-16 20:24:40 +0000
committerflorian <florian@3ad0048d-3df7-0310-abae-a5850022a9f2>2009-09-16 20:24:40 +0000
commit6abaa554bca7e219e13e0cf095cb259c045a8fd8 (patch)
tree883adbcbc6a12dcb27e4295db08efa7a0036206a /packages/hash
parent8b97d51b5e227ab99b732c7f02c220e32545eda3 (diff)
downloadfpc-6abaa554bca7e219e13e0cf095cb259c045a8fd8.tar.gz
+ sha1 unit by Sergei Gorelkin, resolves #14604
git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@13727 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'packages/hash')
-rw-r--r--packages/hash/Makefile118
-rw-r--r--packages/hash/Makefile.fpc2
-rw-r--r--packages/hash/fpmake.pp1
-rw-r--r--packages/hash/src/sha1.pp305
4 files changed, 366 insertions, 60 deletions
diff --git a/packages/hash/Makefile b/packages/hash/Makefile
index 48d06ce34e..34833606a8 100644
--- a/packages/hash/Makefile
+++ b/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
diff --git a/packages/hash/Makefile.fpc b/packages/hash/Makefile.fpc
index e1796e6bee..a043841f09 100644
--- a/packages/hash/Makefile.fpc
+++ b/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
diff --git a/packages/hash/fpmake.pp b/packages/hash/fpmake.pp
index 4f33235ab5..f281d1f0fe 100644
--- a/packages/hash/fpmake.pp
+++ b/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');
diff --git a/packages/hash/src/sha1.pp b/packages/hash/src/sha1.pp
new file mode 100644
index 0000000000..5beaed2236
--- /dev/null
+++ b/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.