AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

SHA! Unit gesucht

Ein Thema von Luckie · begonnen am 25. Mai 2012 · letzter Beitrag vom 29. Mai 2012
Antwort Antwort
Horst0815

Registriert seit: 23. Mai 2011
Ort: Görlitz
150 Beiträge
 
Delphi XE Starter
 
#1

AW: SHA! Unit gesucht

  Alt 25. Mai 2012, 22:40
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)
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es 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

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 13:07 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz