lord_viper
چهارشنبه 25 فروردین 1389, 08:50 صبح
یونیت md5
unit md5;
INTERFACE
uses
Windows;
type
MD5Count = array[0..1] of DWORD;
MD5State = array[0..3] of DWORD;
MD5Block = array[0..15] of DWORD;
MD5CBits = array[0..7] of byte;
MD5Digest = array[0..15] of byte;
MD5Buffer = array[0..63] of byte;
MD5Context = record
State: MD5State;
Count: MD5Count;
Buffer: MD5Buffer;
end;
procedure MD5Init(var Context: MD5Context);
procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
function MD5String(M: string): MD5Digest;
function MD5Print(D: MD5Digest): string;
function MD5Match(D1, D2: MD5Digest): boolean;
IMPLEMENTATION
var
PADDING: MD5Buffer = (
$80, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00
);
function F(x, y, z: DWORD): DWORD;
begin
Result := (x and y) or ((not x) and z);
end;
function G(x, y, z: DWORD): DWORD;
begin
Result := (x and z) or (y and (not z));
end;
function H(x, y, z: DWORD): DWORD;
begin
Result := x xor y xor z;
end;
function I(x, y, z: DWORD): DWORD;
begin
Result := y xor (x or (not z));
end;
procedure rot(var x: DWORD; n: BYTE);
begin
x := (x shl n) or (x shr (32 - n));
end;
procedure FF(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, F(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
procedure GG(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, G(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
procedure HH(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, H(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
procedure II(var a: DWORD; b, c, d, x: DWORD; s: BYTE; ac: DWORD);
begin
inc(a, I(b, c, d) + x + ac);
rot(a, s);
inc(a, b);
end;
procedure Encode(Source, Target: pointer; Count: longword);
var
S: PByte;
T: PDWORD;
I: longword;
begin
S := Source;
T := Target;
for I := 1 to Count div 4 do begin
T^ := S^;
inc(S);
T^ := T^ or (S^ shl 8);
inc(S);
T^ := T^ or (S^ shl 16);
inc(S);
T^ := T^ or (S^ shl 24);
inc(S);
inc(T);
end;
end;
procedure Decode(Source, Target: pointer; Count: longword);
var
S: PDWORD;
T: PByte;
I: longword;
begin
S := Source;
T := Target;
for I := 1 to Count do begin
T^ := S^ and $ff;
inc(T);
T^ := (S^ shr 8) and $ff;
inc(T);
T^ := (S^ shr 16) and $ff;
inc(T);
T^ := (S^ shr 24) and $ff;
inc(T);
inc(S);
end;
end;
procedure Transform(Buffer: pointer; var State: MD5State);
var
a, b, c, d: DWORD;
Block: MD5Block;
begin
Encode(Buffer, @Block, 64);
a := State[0];
b := State[1];
c := State[2];
d := State[3];
FF (a, b, c, d, Block[ 0], 7, $d76aa478);
FF (d, a, b, c, Block[ 1], 12, $e8c7b756);
FF (c, d, a, b, Block[ 2], 17, $242070db);
FF (b, c, d, a, Block[ 3], 22, $c1bdceee);
FF (a, b, c, d, Block[ 4], 7, $f57c0faf);
FF (d, a, b, c, Block[ 5], 12, $4787c62a);
FF (c, d, a, b, Block[ 6], 17, $a8304613);
FF (b, c, d, a, Block[ 7], 22, $fd469501);
FF (a, b, c, d, Block[ 8], 7, $698098d8);
FF (d, a, b, c, Block[ 9], 12, $8b44f7af);
FF (c, d, a, b, Block[10], 17, $ffff5bb1);
FF (b, c, d, a, Block[11], 22, $895cd7be);
FF (a, b, c, d, Block[12], 7, $6b901122);
FF (d, a, b, c, Block[13], 12, $fd987193);
FF (c, d, a, b, Block[14], 17, $a679438e);
FF (b, c, d, a, Block[15], 22, $49b40821);
GG (a, b, c, d, Block[ 1], 5, $f61e2562);
GG (d, a, b, c, Block[ 6], 9, $c040b340);
GG (c, d, a, b, Block[11], 14, $265e5a51);
GG (b, c, d, a, Block[ 0], 20, $e9b6c7aa);
GG (a, b, c, d, Block[ 5], 5, $d62f105d);
GG (d, a, b, c, Block[10], 9, $2441453);
GG (c, d, a, b, Block[15], 14, $d8a1e681);
GG (b, c, d, a, Block[ 4], 20, $e7d3fbc8);
GG (a, b, c, d, Block[ 9], 5, $21e1cde6);
GG (d, a, b, c, Block[14], 9, $c33707d6);
GG (c, d, a, b, Block[ 3], 14, $f4d50d87);
GG (b, c, d, a, Block[ 8], 20, $455a14ed);
GG (a, b, c, d, Block[13], 5, $a9e3e905);
GG (d, a, b, c, Block[ 2], 9, $fcefa3f8);
GG (c, d, a, b, Block[ 7], 14, $676f02d9);
GG (b, c, d, a, Block[12], 20, $8d2a4c8a);
HH (a, b, c, d, Block[ 5], 4, $fffa3942);
HH (d, a, b, c, Block[ 8], 11, $8771f681);
HH (c, d, a, b, Block[11], 16, $6d9d6122);
HH (b, c, d, a, Block[14], 23, $fde5380c);
HH (a, b, c, d, Block[ 1], 4, $a4beea44);
HH (d, a, b, c, Block[ 4], 11, $4bdecfa9);
HH (c, d, a, b, Block[ 7], 16, $f6bb4b60);
HH (b, c, d, a, Block[10], 23, $bebfbc70);
HH (a, b, c, d, Block[13], 4, $289b7ec6);
HH (d, a, b, c, Block[ 0], 11, $eaa127fa);
HH (c, d, a, b, Block[ 3], 16, $d4ef3085);
HH (b, c, d, a, Block[ 6], 23, $4881d05);
HH (a, b, c, d, Block[ 9], 4, $d9d4d039);
HH (d, a, b, c, Block[12], 11, $e6db99e5);
HH (c, d, a, b, Block[15], 16, $1fa27cf8);
HH (b, c, d, a, Block[ 2], 23, $c4ac5665);
II (a, b, c, d, Block[ 0], 6, $f4292244);
II (d, a, b, c, Block[ 7], 10, $432aff97);
II (c, d, a, b, Block[14], 15, $ab9423a7);
II (b, c, d, a, Block[ 5], 21, $fc93a039);
II (a, b, c, d, Block[12], 6, $655b59c3);
II (d, a, b, c, Block[ 3], 10, $8f0ccc92);
II (c, d, a, b, Block[10], 15, $ffeff47d);
II (b, c, d, a, Block[ 1], 21, $85845dd1);
II (a, b, c, d, Block[ 8], 6, $6fa87e4f);
II (d, a, b, c, Block[15], 10, $fe2ce6e0);
II (c, d, a, b, Block[ 6], 15, $a3014314);
II (b, c, d, a, Block[13], 21, $4e0811a1);
II (a, b, c, d, Block[ 4], 6, $f7537e82);
II (d, a, b, c, Block[11], 10, $bd3af235);
II (c, d, a, b, Block[ 2], 15, $2ad7d2bb);
II (b, c, d, a, Block[ 9], 21, $eb86d391);
inc(State[0], a);
inc(State[1], b);
inc(State[2], c);
inc(State[3], d);
end;
procedure MD5Init(var Context: MD5Context);
begin
with Context do begin
State[0] := $67452301;
State[1] := $efcdab89;
State[2] := $98badcfe;
State[3] := $10325476;
Count[0] := 0;
Count[1] := 0;
ZeroMemory(@Buffer, SizeOf(MD5Buffer));
end;
end;
procedure MD5Update(var Context: MD5Context; Input: pChar; Length: longword);
var
Index: longword;
PartLen: longword;
I: longword;
begin
with Context do begin
Index := (Count[0] shr 3) and $3f;
inc(Count[0], Length shl 3);
if Count[0] < (Length shl 3) then inc(Count[1]);
inc(Count[1], Length shr 29);
end;
PartLen := 64 - Index;
if Length >= PartLen then begin
CopyMemory(@Context.Buffer[Index], Input, PartLen);
Transform(@Context.Buffer, Context.State);
I := PartLen;
while I + 63 < Length do begin
Transform(@Input[i], Context.State);
inc(I, 64);
end;
Index := 0;
end else I := 0;
CopyMemory(@Context.Buffer[Index], @Input[i], Length - I);
end;
procedure MD5Final(var Context: MD5Context; var Digest: MD5Digest);
var
Bits: MD5CBits;
Index: longword;
PadLen: longword;
begin
Decode(@Context.Count, @Bits, 2);
Index := (Context.Count[0] shr 3) and $3f;
if Index < 56 then PadLen := 56 - Index else PadLen := 120 - Index;
MD5Update(Context, @PADDING, PadLen);
MD5Update(Context, @Bits, 8);
Decode(@Context.State, @Digest, 4);
ZeroMemory(@Context, SizeOf(MD5Context));
end;
function MD5String(M: string): MD5Digest;
var
Context: MD5Context;
begin
MD5Init(Context);
MD5Update(Context, pChar(M), length(M));
MD5Final(Context, Result);
end;
function MD5Print(D: MD5Digest): string;
var
I: byte;
const
Digits: array[0..15] of char =
('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
begin
Result := '';
for I := 0 to 15 do Result := Result + Digits[(D[i] shr 4) and $0f] + Digits[D[i] and $0f];
end;
function MD5Match(D1, D2: MD5Digest): boolean;
var
I: byte;
begin
I := 0;
Result := TRUE;
while Result and (I < 16) do begin
Result := D1[i] = D2[i];
inc(I);
end;
end;
end.
lord_viper
چهارشنبه 25 فروردین 1389, 15:45 عصر
اگه برای انتی میخواهین اولا توصیه میکنم کل فایل رو هش نکنین بلکه فقط سکشن TEXT یا CODE رو هش کنین چون اگه کل فایل رو هش کنین با تغییر 1 بیت از فایل خرجی تغییر میکنه و انتی اشتباه میکنه در صورتی که تغییر در سکشن کد نیاز به تغییر در سورس فایل و کامپایل مجدد داره
بهتره از CRC#@ استفاده کنین سرعتش بیشتره
یونیت CRC32
unit crc32utils;
interface
uses
windows,sysutils,classes;
TYPE
TInteger8 = Int64;
PROCEDURE CalcCRC32 (p: pointer; ByteCount: DWORD; VAR CRCvalue: DWORD);
PROCEDURE CalcFileCRC32 (FromName: STRING; VAR CRCvalue: DWORD;VAR TotalBytes: TInteger8; VAR error: WORD);
implementation
CONST
table: ARRAY[0..255] OF DWORD =
($00000000, $77073096, $EE0E612C, $990951BA,
$076DC419, $706AF48F, $E963A535, $9E6495A3,
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F,
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
$F762575D, $806567CB, $196C3671, $6E6B06E7,
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
PROCEDURE CalcCRC32 (p: pointer; ByteCount: DWORD; VAR CRCValue: DWORD);
VAR
i: DWORD;
q: ^BYTE;
BEGIN
q := p;
FOR i := 0 TO ByteCount-1 DO BEGIN
CRCvalue := (CRCvalue SHR 8) XOR
Table[ q^ XOR (CRCvalue AND $000000FF) ];
INC(q)
END
END ;
{$IFDEF StreamIO}
PROCEDURE CalcFileCRC32 (FromName: STRING; VAR CRCvalue: DWORD;VAR TotalBytes: TInteger8;VAR error: WORD);
VAR
Stream: TMemoryStream;
BEGIN
error := 0;
CRCValue := $FFFFFFFF;
Stream := TMemoryStream.Create;
TRY
TRY
Stream.LoadFromFile(FromName);
IF Stream.Size > 0
THEN CalcCRC32 (Stream.Memory, Stream.Size, CRCvalue)
EXCEPT
ON E: EReadError DO
error := 1
END;
CRCvalue := NOT CRCvalue
FINALLY
Stream.Free
END;
END ;
{$ELSE}
PROCEDURE CalcFileCRC32 (FromName: STRING; VAR CRCvalue: DWORD;VAR TotalBytes: TInteger8;VAR error: WORD);
CONST
BufferSize = 32768;
TYPE
BufferIndex = 0..BufferSize-1;
TBuffer = ARRAY[BufferIndex] OF BYTE;
pBuffer = ^TBuffer;
VAR
BytesRead: INTEGER;
FromFile : FILE;
IOBuffer : pBuffer;
BEGIN
New(IOBuffer);
TRY
FileMode := 0;
CRCValue := $FFFFFFFF;
ASSIGN (FromFile,FromName);
{$I-} RESET (FromFile,1); {$I+}
error := IOResult;
IF error = 0
THEN BEGIN
TotalBytes := 0;
REPEAT
{$I-}
BlockRead (FromFile, IOBuffer^, BufferSize, BytesRead);
{$I+}
error := IOResult;
IF (error = 0) AND (BytesRead > 0)
THEN BEGIN
CalcCRC32 (IOBuffer, BytesRead, CRCvalue);
TotalBytes := TotalBytes + BytesRead; // can't use INC with COMP
END
UNTIL (BytesRead = 0) OR (error > 0);
CLOSE (FromFile)
END;
CRCvalue := NOT CRCvalue
FINALLY
Dispose(IOBuffer)
END
END ;
{$ENDIF}
END.
lord_viper
چهارشنبه 25 فروردین 1389, 21:31 عصر
این هم الگوریتم sha1
// ================================================== ==========================
// D5-implementation of "US Secure Hash Algorithm 1 (SHA1)" (RFC3174)
// Copyright (c) 2001, Juergen Haible.
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to
// deal in the Software without restriction, including without limitation the
// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
// sell copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in
// all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
// IN THE SOFTWARE.
// ================================================== ==========================
{------------------------------------------------------------------------------
Update by F. Piette for ICS (http://www.overbyte.be)
Jan 10, 2004 Defined uint32_t as LongWord instead of LongInt
Jul 23, 2004 Revised SHA1Reset to check for nil reference to comply with RFC-3174
Made the unit compatible with Delphi 2
------------------------------------------------------------------------------}
unit OverbyteIcsSha1; // "US Secure Hash Algorithm 1 (SHA1)" (RFC3174)
{------------------------------------------------------------------------------
Based on the reference implementation in RFC 3174
------------------------------------------------------------------------------}
interface
{$I OverbyteIcsDefs.inc}
{$R-}
{$Q-}
uses
SysUtils, Classes;
const
IcsSHA1Version = 100;
CopyRight : String = ' IcsSHA1 (c) 2004-2006 F. Piette V1.00 ';
const
shaSuccess = 0;
shaNull = 1;
shaInputTooLong = 2;
shaStateError = 3;
SHA1HashSize = 20;
type
{$IFNDEF COMPILER2_UP}
{$IFNDEF FPC}
Bomb('This code requires Delphi 2 or later'};
{$ENDIF}
{$ENDIF}
{$IFDEF DELPHI4_UP}
uint32_t = LongWord; //Cardinal; // [Should be] unsigned 32 bit integer
{$ELSE}
uint32_t = LongInt;
{$ENDIF}
uint8_t = Byte; // unsigned 8 bit integer (i.e., unsigned char)
int_least16_t = LongInt; // integer of >= 16 bits
SHA1Digest = array[0..SHA1HashSize-1] of Char;
SHA1DigestString = AnsiString; // string containing 20 chars
// This structure will hold context information for the SHA-1
// hashing operation
SHA1Context = record
Intermediate_Hash: array[0..SHA1HashSize div 4-1] of uint32_t; // Message Digest
Length_Low : uint32_t; // Message length in bits
Length_High: uint32_t; // Message length in bits
Message_Block_Index: int_least16_t; // Index into message block array
Message_Block: array[0..63] of uint8_t; // 512-bit message blocks
Computed: Integer; // Is the digest computed?
Corrupted: Integer; // Is the message digest corrupted?
end;
function SHA1Reset ( var context : SHA1Context ): Integer;
function SHA1Input ( var context : SHA1Context;
message_array : PChar;
length : Cardinal ): Integer;
function SHA1Result( var context : SHA1Context;
var Message_Digest: SHA1Digest ): Integer;
function SHA1ofStr ( const s: String ): SHA1DigestString;
function SHA1ofBuf ( const buf; buflen: Integer ): SHA1DigestString;
function SHA1ofStream( const strm: TStream ): SHA1DigestString;
function SHA1toHex( const digest: SHA1DigestString ): String;
procedure HMAC_SHA1( const Data; DataLen: Integer;
const Key; KeyLen : Integer;
{$IFDEF DELPHI3_UP}out
{$ELSE}var{$ENDIF} Digest : SHA1Digest );
function HMAC_SHA1_EX( const Data: String;
const Key : String ): String; //overload;
implementation
// Define the SHA1 circular left shift macro
function SHA1CircularShift( const bits, word: uint32_t ): uint32_t;
begin
Result := (((word) shl (bits)) or ((word) shr (32-(bits))));
end;
// This function will process the next 512 bits of the message
// stored in the Message_Block array.
procedure SHA1ProcessMessageBlock( var context: SHA1Context );
const K: array[0..3] of uint32_t = ( //* Constants defined in SHA-1 */
$5A827999,
$6ED9EBA1,
$8F1BBCDC,
$CA62C1D6
);
var
t: Integer; //* Loop counter */
temp: uint32_t; //* Temporary word value */
W: array[0..79] of uint32_t; //* Word sequence */
A, B, C, D, E: uint32_t; //* Word buffers */
begin
// Initialize the first 16 words in the array W
for t := 0 to 15 do begin
W[t] := context.Message_Block[t * 4 ] shl 24
or context.Message_Block[t * 4 + 1] shl 16
or context.Message_Block[t * 4 + 2] shl 8
or context.Message_Block[t * 4 + 3];
end;
for t := 16 to 79 do begin
W[t] := SHA1CircularShift(1,W[t-3] xor W[t-8] xor W[t-14] xor W[t-16]);
end;
A := context.Intermediate_Hash[0];
B := context.Intermediate_Hash[1];
C := context.Intermediate_Hash[2];
D := context.Intermediate_Hash[3];
E := context.Intermediate_Hash[4];
for t := 0 to 19 do begin
temp := SHA1CircularShift(5,A) +
((B and C) or ((not B) and D)) + E + W[t] + K[0];
E := D;
D := C;
C := SHA1CircularShift(30,B);
B := A;
A := temp;
end;
for t := 20 to 39 do begin
temp := SHA1CircularShift(5,A) + (B xor C xor D) + E + W[t] + K[1];
E := D;
D := C;
C := SHA1CircularShift(30,B);
B := A;
A := temp;
end;
for t := 40 to 59 do begin
temp := SHA1CircularShift(5,A) +
((B and C) or (B and D) or (C and D)) + E + W[t] + K[2];
E := D;
D := C;
C := SHA1CircularShift(30,B);
B := A;
A := temp;
end;
for t := 60 to 79 do begin
temp := SHA1CircularShift(5,A) + (B xor C xor D) + E + W[t] + K[3];
E := D;
D := C;
C := SHA1CircularShift(30,B);
B := A;
A := temp;
end;
inc( context.Intermediate_Hash[0], A );
inc( context.Intermediate_Hash[1], B );
inc( context.Intermediate_Hash[2], C );
inc( context.Intermediate_Hash[3], D );
inc( context.Intermediate_Hash[4], E );
context.Message_Block_Index := 0;
end;
// According to the standard, the message must be padded to an even
// 512 bits. The first padding bit must be a '1'. The last 64
// bits represent the length of the original message. All bits in
// between should be 0. This function will pad the message
// according to those rules by filling the Message_Block array
// accordingly. It will also call the ProcessMessageBlock function
// provided appropriately. When it returns, it can be assumed that
// the message digest has been computed.
procedure SHA1PadMessage( var context: SHA1Context );
begin
(*
* Check to see if the current message block is too small to hold
* the initial padding bits and length. If so, we will pad the
* block, process it, and then continue padding into a second
* block.
*)
if (context.Message_Block_Index > 55) then begin
context.Message_Block[context.Message_Block_Index] := $80;
inc( context.Message_Block_Index );
while (context.Message_Block_Index < 64) do begin
context.Message_Block[context.Message_Block_Index] := 0;
inc( context.Message_Block_Index );
end;
SHA1ProcessMessageBlock( context );
while (context.Message_Block_Index < 56) do begin
context.Message_Block[context.Message_Block_Index] := 0;
inc( context.Message_Block_Index );
end;
end else begin
context.Message_Block[context.Message_Block_Index] := $80;
inc( context.Message_Block_Index );
while (context.Message_Block_Index < 56) do begin
context.Message_Block[context.Message_Block_Index] := 0;
inc( context.Message_Block_Index );
end;
end;
// Store the message length as the last 8 octets
context.Message_Block[56] := context.Length_High shr 24;
context.Message_Block[57] := context.Length_High shr 16;
context.Message_Block[58] := context.Length_High shr 8;
context.Message_Block[59] := context.Length_High;
context.Message_Block[60] := context.Length_Low shr 24;
context.Message_Block[61] := context.Length_Low shr 16;
context.Message_Block[62] := context.Length_Low shr 8;
context.Message_Block[63] := context.Length_Low;
SHA1ProcessMessageBlock(context);
end;
// This function will initialize the SHA1Context in preparation
// for computing a new SHA1 message digest.
function SHA1Reset( var context: SHA1Context ): Integer;
begin
//FPiette
if @context = nil then begin
Result := shaNull;
Exit;
end;
context.Length_Low := 0;
context.Length_High := 0;
context.Message_Block_Index := 0;
context.Intermediate_Hash[0] := $67452301;
context.Intermediate_Hash[1] := $EFCDAB89;
context.Intermediate_Hash[2] := $98BADCFE;
context.Intermediate_Hash[3] := $10325476;
context.Intermediate_Hash[4] := $C3D2E1F0;
context.Computed := 0;
context.Corrupted := 0;
Result := shaSuccess;
end;
// This function will return the 160-bit message digest into the
// Message_Digest array provided by the caller.
function SHA1Result( var context: SHA1Context;
var Message_Digest: SHA1Digest ): Integer;
var i: Integer;
begin
// if (!context || !Message_Digest) then begin Result:=shaNull; exit end;
if (context.Corrupted<>0) then begin Result:=context.Corrupted; exit end;
if (context.Computed=0) then begin
SHA1PadMessage( context );
for i:=0 to 63 do begin
//* message may be sensitive, clear it out */
context.Message_Block[i] := 0;
end;
context.Length_Low := 0; //* and clear length */
context.Length_High := 0;
context.Computed := 1;
end;
for i := 0 to SHA1HashSize-1 do begin
Message_Digest[i] := chr( context.Intermediate_Hash[i shr 2]
shr ( 8 * ( 3 - ( uint32_t(i) and $03 ) ) ) );
end;
Result := shaSuccess;
end;
// This function accepts an array of octets as the next portion
// of the message.
function SHA1Input( var context: SHA1Context;
message_array: PChar;
length: Cardinal ): Integer;
begin
if (length=0) then begin Result:=shaSuccess; exit end;
// if (!context || !message_array) then begin Result:=shaNull; exit end;
if (message_array=nil) then begin Result:=shaNull; exit end;
if (context.Computed<>0) then begin
context.Corrupted := shaStateError;
Result := shaStateError;
exit;
end;
if (context.Corrupted<>0) then begin
Result := context.Corrupted;
exit;
end;
while (length>0) and (context.Corrupted=0) do begin
context.Message_Block[context.Message_Block_Index] := (ord(message_array^) and $FF);
inc( context.Message_Block_Index );
inc( context.Length_Low, 8 );
if (context.Length_Low = 0) then begin
inc( context.Length_High );
if (context.Length_High = 0) then begin
// Message is too long
context.Corrupted := 1;
end;
end;
if (context.Message_Block_Index = 64) then begin
SHA1ProcessMessageBlock(context);
end;
inc( message_array );
dec( length );
end;
Result := shaSuccess;
end;
// ----------------------------------------------------------------------------
// returns SHA1 digest of given string
function SHA1ofStr( const s: String ): SHA1DigestString;
var context: SHA1Context;
digest : SHA1Digest;
begin
SHA1Reset ( context);
SHA1Input ( context, PChar( @s[1] ), length(s) );
SHA1Result( context, digest );
SetLength( Result, sizeof(digest) );
Move( digest, Result[1], sizeof(digest) );
end;
// returns SHA1 digest of given buffer
function SHA1ofBuf( const buf; buflen: Integer ): SHA1DigestString;
var context: SHA1Context;
digest : SHA1Digest;
begin
SHA1Reset ( context);
SHA1Input ( context, PChar( buf ), buflen );
SHA1Result( context, digest );
SetLength( Result, sizeof(digest) );
Move( digest, Result[1], sizeof(digest) );
end;
// returns SHA1 digest of given stream
function SHA1ofStream( const strm: TStream ): SHA1DigestString;
var context: SHA1Context;
digest : SHA1Digest;
buf: array[0..4095] of char;
buflen: Integer;
begin
SHA1Reset ( context);
strm.Position := 0;
repeat
buflen := strm.Read( buf[0], 4096 );
if buflen>0 then SHA1Input ( context, buf, buflen );
until buflen<4096;
SHA1Result( context, digest );
SetLength( Result, sizeof(digest) );
Move( digest, Result[1], sizeof(digest) );
end;
// converts SHA1 digest into a hex-string
function SHA1toHex( const digest: SHA1DigestString ): String;
var i: Integer;
begin
Result := '';
for i:=1 to length(digest) do Result := Result + inttohex( ord( digest[i] ), 2 );
Result := LowerCase( Result );
end;
// ----------------------------------------------------------------------------
// Keyed SHA1 (HMAC-SHA1), RFC 2104
procedure HMAC_SHA1( const Data; DataLen: Integer;
const Key; KeyLen : Integer;
{$IFDEF DELPHI3_UP}out
{$ELSE}var{$ENDIF} Digest : SHA1Digest );
var k_ipad, k_opad: array[0..64] of Byte;
Context: SHA1Context;
i : Integer;
begin
// clear pads
FillChar( k_ipad, sizeof(k_ipad), 0 );
FillChar( k_opad, sizeof(k_ipad), 0 );
if KeyLen > 64 then begin
// if key is longer than 64 bytes reset it to key=SHA1(key)
SHA1Reset ( Context);
SHA1Input ( Context, PChar(@Key), KeyLen );
SHA1Result( Context, Digest );
// store key in pads
Move( Digest, k_ipad, SHA1HashSize );
Move( Digest, k_opad, SHA1HashSize );
end else begin
// store key in pads
Move( Key, k_ipad, KeyLen );
Move( Key, k_opad, KeyLen );
end;
// XOR key with ipad and opad values
for i:=0 to 63 do begin
k_ipad[i] := k_ipad[i] xor $36;
k_opad[i] := k_opad[i] xor $5c;
end;
// perform inner SHA1
SHA1Reset ( Context );
SHA1Input ( Context, PChar(@k_ipad[0]), 64 );
SHA1Input ( Context, PChar(@Data), DataLen );
SHA1Result( Context, Digest );
// perform outer SHA1
SHA1Reset ( Context );
SHA1Input ( Context, PChar(@k_opad[0]), 64 );
SHA1Input ( Context, Digest, SHA1HashSize );
SHA1Result( Context, Digest );
end;
function HMAC_SHA1_EX( const Data: String;
const Key : String ): String;
var Digest: SHA1Digest;
begin
HMAC_SHA1( Data[1], length(Data), Key[1], length(Key), Digest );
SetLength( Result, SHA1HashSize );
Move( digest[0], Result[1], SHA1HashSize );
end;
// ----------------------------------------------------------------------------
{
SHA1 test suit:
procedure TForm1.Button1Click(Sender: TObject);
const TEST1 = 'abc';
TEST2a = 'abcdbcdecdefdefgefghfghighijhi';
TEST2b = 'jkijkljklmklmnlmnomnopnopq';
TEST2 = TEST2a + TEST2b;
TEST3 = 'a';
TEST4a = '01234567012345670123456701234567';
TEST4b = '01234567012345670123456701234567';
TEST4 = TEST4a + TEST4b;
testarray: array[0..3] of String = ( TEST1, TEST2, TEST3, TEST4 );
repeatcount: array[0..3] of Integer = ( 1, 1, 1000000, 10 );
resultarray: array [0..3] of String = (
'A9 99 3E 36 47 06 81 6A BA 3E 25 71 78 50 C2 6C 9C D0 D8 9D',
'84 98 3E 44 1C 3B D2 6E BA AE 4A A1 F9 51 29 E5 E5 46 70 F1',
'34 AA 97 3C D4 C4 DA A4 F6 1E EB 2B DB AD 27 31 65 34 01 6F',
'DE A3 56 A2 CD DD 90 C7 A7 EC ED C5 EB B5 63 93 4F 46 04 52' );
var sha: SHA1Context;
i, j, err: Integer;
Message_Digest: SHA1Digest;
s: String;
begin
for j := 0 to 3 do begin
ListBox1.Items.Add( Format( 'Test %d: %d, "%s"',
[ j+1, repeatcount[j], testarray[j] ] ) );
err := SHA1Reset(sha);
if (err<>0) then begin
ListBox1.Items.Add( Format( 'SHA1Reset Error %d.', [err] ) );
break; //* out of for j loop */
end;
for i := 0 to repeatcount[j]-1 do begin
err := SHA1Input( sha, @testarray[j][1], length(testarray[j]) );
if (err<>0) then begin
ListBox1.Items.Add( Format('SHA1Input Error %d.', [err] ) );
break; //* out of for i loop */
end;
end;
err := SHA1Result(sha, Message_Digest);
if (err<>0) then begin
ListBox1.Items.Add( Format(
'SHA1Result Error %d, could not compute message digest.', [err] ) );
end else begin
s := '';
for i := 0 to 19 do begin
s := s + Format('%02X ', [ ord(Message_Digest[i]) ] );
end;
ListBox1.Items.Add( 'Result: ' + s );
end;
ListBox1.Items.Add( 'Wanted: ' + Format('%s', [resultarray[j]] ) );
end;
end;
HMAC-SHA1 test suite of RFC 2202:
procedure TForm1.Button3Click(Sender: TObject);
end;
}
end.
در مورد پیدا کردن سکشن کد یک نمونه مثال تو قسمت نمونه سورس ها هست به اسم mini peid میتونین از اون استفاده کنین
vBulletin® v4.2.5, Copyright ©2000-1404, Jelsoft Enterprises Ltd.