SHA! Unit gesucht

[Luckie]

Hallo,
ich suche eine SH1 Unit für Delphi (BDS2006). Es sollte eine einfache Unit sein, wie ich sie für MD5 gefunden habe. Ich will keine große Komponentensammlung oder das DEC benutzen müssen. Kennt da jemand was? meine Google- und Forensuche war bisher leider erfolglos.

[Aphton]

War bei der MD5 Unit kein SHA dabei? Falls nicht, dann uppe ich mal die überarbeitete Version mit diversen anderen Hash APIs hoch.

Edit: So, habs gefunden...
Da ist noch einiges dazu gekommen.. Also nicht wundern

[Horst0815]

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.

[Luckie]

Nein. In der Unit ist nur MD5 enthalten. ich habe sie als Anhang hier im Forum gefunden.

ja, das wäre nett. ist es eine einzelne Unit?

[Luckie]

@Horst0815: Danke, das sieht gut aus. Hast du dafür auch ein Anwendungsbeispiel für eine Datei?

[Aphton]

Jop, es ist im Grunde dieselbe MD5 Unit (von mir), die eben erweitert wurde - hab dich nicht wirklich benachrichtigt und dich auf den neusten Stand gebracht.

SHA benützt du eig. genauso wie MD5 (und auch MD4 nun)... Nichts hat sich geändert!

[himitsu]

http://www.delphipraxis.net/155688-mini-sha1.html


@Horst0815: Sicher daß dein Code noch in XE (2009+) läuft? (speziell der Selbsttest :roll:)

[Luckie]

Also ich habe die:

Delphi-Quellcode:

{******************************************************************}
{          MD5 Hashsum Evaluation Unit For Borland Delphi          }
{                                                                  }
{          Copyright © 2002 by Dimka Maslov                        }
{          E-mail:   [e-mail],                             }
{          Web-site: http://www.endimus.com                        }
{                                                                  }
{         Derived from the RSA Data Security, Inc.                 }
{         MD5 Message-Digest Algorithm described in RFC 1321       }
{         http://www.faqs.org/rfcs/rfc1321.html                    }
{******************************************************************}

Der kann ich eine Datei über geben und bekomme eine Digest zurück den ich mit einer Funktion aus der Unit in einen String umwandeln kann. Und so was suche ich auch für SHA1 bzw. der Unit von Horst übergebe ich wohl den Dateiinhalt als Buffer, aber wie wandele ich den Digest in einen String um?

[Aphton]

Ich dachte mir, du redest hiervon
http://www.michael-puff.de/Programmi...mporte/Aphton/

[Luckie]

Verdammt. Ich kenne mich auf meinen eigenen Webspace nicht mehr aus. ;) Aber da ist SHA1 auch nicht dabei.