SHA1.pas 6.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261
  1. unit SHA1;
  2. {
  3. SHA1.pas: SHA-1 hash implementation, based on RFC 3174 and MD5.pas
  4. Author: Jordan Russell, 2010-02-24
  5. License for SHA1.pas: Public domain, no copyright claimed
  6. }
  7. interface
  8. type
  9. TSHA1Word = LongWord;
  10. TSHA1Buf = array[0..4] of TSHA1Word;
  11. TSHA1In = array[0..15] of TSHA1Word;
  12. TSHA1WArray = array[0..79] of TSHA1Word;
  13. TSHA1Context = record
  14. buf: TSHA1Buf;
  15. bytes: array[0..1] of TSHA1Word;
  16. in_: TSHA1In;
  17. W: TSHA1WArray;
  18. end;
  19. TSHA1Digest = array[0..19] of Byte;
  20. procedure SHA1Init(var ctx: TSHA1Context);
  21. procedure SHA1Update(var ctx: TSHA1Context; const buffer; len: Cardinal);
  22. function SHA1Final(var ctx: TSHA1Context): TSHA1Digest;
  23. function SHA1Buf(const Buffer; Len: Cardinal): TSHA1Digest;
  24. function SHA1DigestsEqual(const A, B: TSHA1Digest): Boolean;
  25. function SHA1DigestToString(const D: TSHA1Digest): String;
  26. implementation
  27. procedure SHA1Transform(var buf: TSHA1Buf; const in_: TSHA1In; var W: TSHA1WArray); forward;
  28. function ByteSwap(const X: TSHA1Word): TSHA1Word;
  29. begin
  30. Result :=
  31. (X shl 24) or
  32. ((X and $FF00) shl 8) or
  33. ((X and $FF0000) shr 8) or
  34. (X shr 24);
  35. end;
  36. (*
  37. * Start SHA-1 accumulation. Set byte count to 0 and buffer to mysterious
  38. * initialization constants.
  39. *)
  40. procedure SHA1Init(var ctx: TSHA1Context);
  41. begin
  42. ctx.buf[0] := TSHA1Word($67452301);
  43. ctx.buf[1] := TSHA1Word($efcdab89);
  44. ctx.buf[2] := TSHA1Word($98badcfe);
  45. ctx.buf[3] := TSHA1Word($10325476);
  46. ctx.buf[4] := TSHA1Word($c3d2e1f0);
  47. ctx.bytes[0] := 0;
  48. ctx.bytes[1] := 0;
  49. end;
  50. (*
  51. * Update context to reflect the concatenation of another buffer full
  52. * of bytes.
  53. *)
  54. procedure SHA1Update(var ctx: TSHA1Context; const buffer; len: Cardinal);
  55. var
  56. buf: ^Byte;
  57. t: TSHA1Word;
  58. begin
  59. buf := @buffer;
  60. { Update byte count }
  61. t := ctx.bytes[0];
  62. Inc(ctx.bytes[0], len);
  63. if Cardinal(ctx.bytes[0]) < Cardinal(t) then
  64. Inc(ctx.bytes[1]); { Carry from low to high }
  65. t := 64 - (t and $3f); { Space available in ctx.in (at least 1) }
  66. if Cardinal(t) > Cardinal(len) then begin
  67. Move(buf^, Pointer(Cardinal(@ctx.in_) + 64 - t)^, len);
  68. Exit;
  69. end;
  70. { First chunk is an odd size }
  71. Move(buf^, Pointer(Cardinal(@ctx.in_) + 64 - t)^, t);
  72. SHA1Transform(ctx.buf, ctx.in_, ctx.W);
  73. Inc(buf, t);
  74. Dec(len, t);
  75. { Process data in 64-byte chunks }
  76. while Cardinal(len) >= Cardinal(64) do begin
  77. Move(buf^, ctx.in_, 64);
  78. SHA1Transform(ctx.buf, ctx.in_, ctx.W);
  79. Inc(buf, 64);
  80. Dec(len, 64);
  81. end;
  82. { Handle any remaining bytes of data. }
  83. Move(buf^, ctx.in_, len);
  84. end;
  85. (*
  86. * Final wrapup - pad to 64-byte boundary with the bit pattern
  87. * 1 0* (64-bit count of bits processed, MSB-first)
  88. *)
  89. function SHA1Final(var ctx: TSHA1Context): TSHA1Digest;
  90. var
  91. count, i: Integer;
  92. p: ^Byte;
  93. begin
  94. count := ctx.bytes[0] and $3f; { Number of bytes in ctx.in }
  95. p := @ctx.in_;
  96. Inc(p, count);
  97. { Set the first char of padding to 0x80. There is always room. }
  98. p^ := $80;
  99. Inc(p);
  100. { Bytes of padding needed to make 56 bytes (-8..55) }
  101. count := 56 - 1 - count;
  102. if count < 0 then begin { Padding forces an extra block }
  103. FillChar(p^, count + 8, 0);
  104. SHA1Transform(ctx.buf, ctx.in_, ctx.W);
  105. p := @ctx.in_;
  106. count := 56;
  107. end;
  108. FillChar(p^, count, 0);
  109. { Append length in bits and transform }
  110. ctx.in_[15] := ByteSwap(ctx.bytes[0] shl 3);
  111. ctx.in_[14] := ByteSwap((ctx.bytes[1] shl 3) or (ctx.bytes[0] shr 29));
  112. SHA1Transform(ctx.buf, ctx.in_, ctx.W);
  113. for i := 0 to High(ctx.buf) do
  114. ctx.buf[i] := ByteSwap(ctx.buf[i]);
  115. Move(ctx.buf, Result, SizeOf(Result));
  116. FillChar(ctx, SizeOf(ctx), 0); { In case it's sensitive }
  117. end;
  118. (*
  119. * The core of the SHA-1 algorithm, this alters an existing SHA-1 hash to
  120. * reflect the addition of 16 longwords of new data. SHA1Update blocks
  121. * the data and converts bytes into longwords for this routine.
  122. *)
  123. procedure SHA1Transform(var buf: TSHA1Buf; const in_: TSHA1In; var W: TSHA1WArray);
  124. const
  125. K1 = $5A827999;
  126. K2 = $6ED9EBA1;
  127. K3 = $8F1BBCDC;
  128. K4 = $CA62C1D6;
  129. var
  130. t: Integer;
  131. temp, A, B, C, D, E: TSHA1Word;
  132. begin
  133. for t := 0 to 15 do begin
  134. { ByteSwap inlined: }
  135. temp := in_[t];
  136. W[t] := (temp shl 24) or
  137. ((temp and $FF00) shl 8) or
  138. ((temp and $FF0000) shr 8) or
  139. (temp shr 24);
  140. end;
  141. for t := 16 to 79 do begin
  142. temp := W[t-3] xor W[t-8] xor W[t-14] xor W[t-16];
  143. W[t] := (temp shl 1) or (temp shr (32-1));
  144. end;
  145. A := buf[0];
  146. B := buf[1];
  147. C := buf[2];
  148. D := buf[3];
  149. E := buf[4];
  150. for t := 0 to 19 do begin
  151. temp := ((A shl 5) or (A shr (32-5))) +
  152. (D xor (B and (C xor D))) + E + W[t] + K1;
  153. E := D;
  154. D := C;
  155. C := (B shl 30) or (B shr (32-30));
  156. B := A;
  157. A := temp;
  158. end;
  159. for t := 20 to 39 do begin
  160. temp := ((A shl 5) or (A shr (32-5))) + (B xor C xor D) + E + W[t] + K2;
  161. E := D;
  162. D := C;
  163. C := (B shl 30) or (B shr (32-30));
  164. B := A;
  165. A := temp;
  166. end;
  167. for t := 40 to 59 do begin
  168. temp := ((A shl 5) or (A shr (32-5))) +
  169. ((B and C) or (B and D) or (C and D)) + E + W[t] + K3;
  170. E := D;
  171. D := C;
  172. C := (B shl 30) or (B shr (32-30));
  173. B := A;
  174. A := temp;
  175. end;
  176. for t := 60 to 79 do begin
  177. temp := ((A shl 5) or (A shr (32-5))) + (B xor C xor D) + E + W[t] + K4;
  178. E := D;
  179. D := C;
  180. C := (B shl 30) or (B shr (32-30));
  181. B := A;
  182. A := temp;
  183. end;
  184. Inc(buf[0], A);
  185. Inc(buf[1], B);
  186. Inc(buf[2], C);
  187. Inc(buf[3], D);
  188. Inc(buf[4], E);
  189. end;
  190. { New functions by JR: }
  191. function SHA1Buf(const Buffer; Len: Cardinal): TSHA1Digest;
  192. var
  193. Context: TSHA1Context;
  194. begin
  195. SHA1Init(Context);
  196. SHA1Update(Context, Buffer, Len);
  197. Result := SHA1Final(Context);
  198. end;
  199. function SHA1DigestsEqual(const A, B: TSHA1Digest): Boolean;
  200. var
  201. I: Integer;
  202. begin
  203. for I := Low(TSHA1Digest) to High(TSHA1Digest) do
  204. if A[I] <> B[I] then begin
  205. Result := False;
  206. Exit;
  207. end;
  208. Result := True;
  209. end;
  210. function SHA1DigestToString(const D: TSHA1Digest): String;
  211. const
  212. Digits: array[0..15] of Char = '0123456789abcdef';
  213. var
  214. Buf: array[0..39] of Char;
  215. P: PChar;
  216. I: Integer;
  217. begin
  218. P := @Buf;
  219. for I := 0 to 19 do begin
  220. P^ := Digits[D[I] shr 4];
  221. Inc(P);
  222. P^ := Digits[D[I] and 15];
  223. Inc(P);
  224. end;
  225. SetString(Result, Buf, 40);
  226. end;
  227. end.