|
![]() |
|
Registriert seit: 23. Mai 2011 Ort: Görlitz 150 Beiträge Delphi XE Starter |
#1
Delphi-Quellcode:
unit SHA1;
interface uses Sysutils, Windows; 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; function SHA1SelfTest: boolean; procedure SHA1Init(var Context: TSHA1Context); procedure SHA1Update(var Context: TSHA1Context; Buffer: pointer; Len: integer); procedure SHA1Final(var Context: TSHA1Context; var Digest: TSHA1Digest); //****************************************************************************** implementation {$R-} function LRot16(X: word; c: integer): word; assembler; asm mov ecx,&c mov ax,&X rol ax,cl mov &Result,ax end; function RRot16(X: word; c: integer): word; assembler; asm mov ecx,&c mov ax,&X ror ax,cl mov &Result,ax end; function LRot32(X: dword; c: integer): dword; register; assembler; asm mov ecx, edx rol eax, cl end; function RRot32(X: dword; c: integer): dword; register; assembler; asm mov ecx, edx ror eax, cl end; procedure XorBlock(I1, I2, O1: PByteArray; Len: integer); var i: integer; begin for i:= 0 to Len-1 do O1[i]:= I1[i] xor I2[i]; end; procedure IncBlock(P: PByteArray; Len: integer); begin Inc(P[Len-1]); if (P[Len-1]= 0) and (Len> 1) then IncBlock(P,Len-1); end; function SHA1SelfTest: boolean; const s: string= 'abc'; OutDigest: TSHA1Digest= ($a9,$99,$3e,$36,$47,$06,$81,$6a,$ba,$3e,$25,$71,$78,$50,$c2,$6c,$9c,$d0,$d8,$9d); var Context: TSHA1Context; Digest: TSHA1Digest; begin SHA1Init(Context); SHA1Update(Context,@s[1],length(s)); SHA1Final(Context,Digest); if CompareMem(@Digest,@OutDigest,Sizeof(Digest)) then Result:= true else Result:= false; 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; end.
Delphi-Quellcode:
unit SHA1;
{ SHA1.pas: SHA-1 hash implementation, based on RFC 3174 and MD5.pas Author: Jordan Russell, 2010-02-24 License for SHA1.pas: Public domain, no copyright claimed $jrsoftware: issrc/Projects/SHA1.pas,v 1.1 2010/02/25 04:57:34 jr Exp $ } interface {$IFNDEF VER80} {$IFNDEF VER90} {$IFNDEF VER93} {$IFNDEF VER100} {$IFNDEF VER110} {$DEFINE SHA1_D4PLUS} {$ENDIF} {$ENDIF} {$ENDIF} {$ENDIF} {$ENDIF} type TSHA1Word = {$IFDEF SHA1_D4PLUS} LongWord {$ELSE} Cardinal {$ENDIF}; TSHA1Buf = array[0..4] of TSHA1Word; TSHA1In = array[0..15] of TSHA1Word; TSHA1WArray = array[0..79] of TSHA1Word; TSHA1Context = record buf: TSHA1Buf; bytes: array[0..1] of TSHA1Word; in_: TSHA1In; W: TSHA1WArray; end; TSHA1Digest = array[0..19] of Byte; procedure SHA1Init(var ctx: TSHA1Context); procedure SHA1Update(var ctx: TSHA1Context; const buffer; len: Cardinal); function SHA1Final(var ctx: TSHA1Context): TSHA1Digest; function SHA1Buf(const Buffer; Len: Cardinal): TSHA1Digest; function SHA1DigestsEqual(const A, B: TSHA1Digest): Boolean; function SHA1DigestToString(const D: TSHA1Digest): String; implementation procedure SHA1Transform(var buf: TSHA1Buf; const in_: TSHA1In; var W: TSHA1WArray); forward; function ByteSwap(const X: TSHA1Word): TSHA1Word; begin Result := (X shl 24) or ((X and $FF00) shl 8) or ((X and $FF0000) shr 8) or (X shr 24); end; (* * Start SHA-1 accumulation. Set byte count to 0 and buffer to mysterious * initialization constants. *) procedure SHA1Init(var ctx: TSHA1Context); begin ctx.buf[0] := TSHA1Word($67452301); ctx.buf[1] := TSHA1Word($efcdab89); ctx.buf[2] := TSHA1Word($98badcfe); ctx.buf[3] := TSHA1Word($10325476); ctx.buf[4] := TSHA1Word($c3d2e1f0); ctx.bytes[0] := 0; ctx.bytes[1] := 0; end; (* * Update context to reflect the concatenation of another buffer full * of bytes. *) procedure SHA1Update(var ctx: TSHA1Context; const buffer; len: Cardinal); var buf: ^Byte; t: TSHA1Word; begin buf := @buffer; { Update byte count } t := ctx.bytes[0]; Inc(ctx.bytes[0], len); if Cardinal(ctx.bytes[0]) < Cardinal(t) then Inc(ctx.bytes[1]); { Carry from low to high } t := 64 - (t and $3f); { Space available in ctx.in (at least 1) } if Cardinal(t) > Cardinal(len) then begin Move(buf^, Pointer(Cardinal(@ctx.in_) + 64 - t)^, len); Exit; end; { First chunk is an odd size } Move(buf^, Pointer(Cardinal(@ctx.in_) + 64 - t)^, t); SHA1Transform(ctx.buf, ctx.in_, ctx.W); Inc(buf, t); Dec(len, t); { Process data in 64-byte chunks } while Cardinal(len) >= Cardinal(64) do begin Move(buf^, ctx.in_, 64); SHA1Transform(ctx.buf, ctx.in_, ctx.W); Inc(buf, 64); Dec(len, 64); end; { Handle any remaining bytes of data. } Move(buf^, ctx.in_, len); end; (* * Final wrapup - pad to 64-byte boundary with the bit pattern * 1 0* (64-bit count of bits processed, MSB-first) *) function SHA1Final(var ctx: TSHA1Context): TSHA1Digest; var count, i: Integer; p: ^Byte; begin count := ctx.bytes[0] and $3f; { Number of bytes in ctx.in } p := @ctx.in_; Inc(p, count); { Set the first char of padding to 0x80. There is always room. } p^ := $80; Inc(p); { Bytes of padding needed to make 56 bytes (-8..55) } count := 56 - 1 - count; if count < 0 then begin { Padding forces an extra block } FillChar(p^, count + 8, 0); SHA1Transform(ctx.buf, ctx.in_, ctx.W); p := @ctx.in_; count := 56; end; FillChar(p^, count, 0); { Append length in bits and transform } ctx.in_[15] := ByteSwap(ctx.bytes[0] shl 3); ctx.in_[14] := ByteSwap((ctx.bytes[1] shl 3) or (ctx.bytes[0] shr 29)); SHA1Transform(ctx.buf, ctx.in_, ctx.W); for i := 0 to High(ctx.buf) do ctx.buf[i] := ByteSwap(ctx.buf[i]); Move(ctx.buf, Result, SizeOf(Result)); FillChar(ctx, SizeOf(ctx), 0); { In case it's sensitive } end; (* * The core of the SHA-1 algorithm, this alters an existing SHA-1 hash to * reflect the addition of 16 longwords of new data. SHA1Update blocks * the data and converts bytes into longwords for this routine. *) procedure SHA1Transform(var buf: TSHA1Buf; const in_: TSHA1In; var W: TSHA1WArray); const K1 = $5A827999; K2 = $6ED9EBA1; K3 = $8F1BBCDC; K4 = $CA62C1D6; var t: Integer; temp, A, B, C, D, E: TSHA1Word; begin for t := 0 to 15 do begin { ByteSwap inlined: } temp := in_[t]; W[t] := (temp shl 24) or ((temp and $FF00) shl 8) or ((temp and $FF0000) shr 8) or (temp shr 24); end; for t := 16 to 79 do begin temp := W[t-3] xor W[t-8] xor W[t-14] xor W[t-16]; W[t] := (temp shl 1) or (temp shr (32-1)); end; A := buf[0]; B := buf[1]; C := buf[2]; D := buf[3]; E := buf[4]; for t := 0 to 19 do begin temp := ((A shl 5) or (A shr (32-5))) + (D xor (B and (C xor D))) + E + W[t] + K1; E := D; D := C; C := (B shl 30) or (B shr (32-30)); B := A; A := temp; end; for t := 20 to 39 do begin temp := ((A shl 5) or (A shr (32-5))) + (B xor C xor D) + E + W[t] + K2; E := D; D := C; C := (B shl 30) or (B shr (32-30)); B := A; A := temp; end; for t := 40 to 59 do begin temp := ((A shl 5) or (A shr (32-5))) + ((B and C) or (B and D) or (C and D)) + E + W[t] + K3; E := D; D := C; C := (B shl 30) or (B shr (32-30)); B := A; A := temp; end; for t := 60 to 79 do begin temp := ((A shl 5) or (A shr (32-5))) + (B xor C xor D) + E + W[t] + K4; E := D; D := C; C := (B shl 30) or (B shr (32-30)); B := A; A := temp; end; Inc(buf[0], A); Inc(buf[1], B); Inc(buf[2], C); Inc(buf[3], D); Inc(buf[4], E); end; { New functions by JR: } function SHA1Buf(const Buffer; Len: Cardinal): TSHA1Digest; var Context: TSHA1Context; begin SHA1Init(Context); SHA1Update(Context, Buffer, Len); Result := SHA1Final(Context); end; function SHA1DigestsEqual(const A, B: TSHA1Digest): Boolean; var I: Integer; begin for I := Low(TSHA1Digest) to High(TSHA1Digest) do if A[I] <> B[I] then begin Result := False; Exit; end; Result := True; end; function SHA1DigestToString(const D: TSHA1Digest): String; const Digits: array[0..15] of Char = '0123456789abcdef'; var Buf: array[0..39] of Char; P: PChar; I: Integer; begin P := @Buf; for I := 0 to 19 do begin P^ := Digits[D[I] shr 4]; Inc(P); P^ := Digits[D[I] and 15]; Inc(P); end; SetString(Result, Buf, 40); end; end. Geändert von Horst0815 (25. Mai 2012 um 22:58 Uhr) |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |