hackbard: LEA-128 Hash Calculator

Unit LEA_Hash.pas

unit LEA_Hash;

interface

uses Windows, SysUtils, Dialogs;

const
  HashTable: array [0..3] of Longword = ($CF306227, $4FCE8AC8, $ACE059ED, $4E3079A6);

const
  HashTransform: array [0..255] of Longword = (
  $3E8A42F7,$181354AB,$3026A956,$2835FDFD,$1D59D743,$054A83E8,$2D7F7E15,$356C2ABE,
  $3AB3AE86,$22A0FA2D,$0A9507D0,$1286537B,$27EA79C5,$3FF92D6E,$17CCD093,$0FDF8438,
  $0873D8E3,$10608C48,$385571B5,$2046251E,$152A0FA0,$0D395B0B,$250CA6F6,$3D1FF25D,
  $32C07665,$2AD322CE,$02E6DF33,$1AF58B98,$2F99A126,$378AF58D,$1FBF0870,$07AC5CDB,
  $10E7B1C6,$08F4E56D,$20C11890,$38D24C3B,$0DBE6685,$15AD322E,$3D98CFD3,$258B9B78,
  $2A541F40,$32474BEB,$1A72B616,$0261E2BD,$370DC803,$2F1E9CA8,$072B6155,$1F3835FE,
  $18946925,$00873D8E,$28B2C073,$30A194D8,$05CDBE66,$1DDEEACD,$35EB1730,$2DF8439B,
  $2227C7A3,$3A349308,$12016EF5,$0A123A5E,$3F7E10E0,$276D444B,$0F58B9B6,$174BED1D,
  $21CF638C,$39DC3727,$11E9CADA,$09FA9E71,$3C96B4CF,$2485E064,$0CB01D99,$14A34932,
  $1B7CCD0A,$036F99A1,$2B5A645C,$334930F7,$06251A49,$1E364EE2,$3603B31F,$2E10E7B4,
  $29BCBB6F,$31AFEFC4,$199A1239,$01894692,$34E56C2C,$2CF63887,$04C3C57A,$1CD091D1,
  $130F15E9,$0B1C4142,$2329BCBF,$3B3AE814,$0E56C2AA,$16459601,$3E706BFC,$26633F57,
  $3128D24A,$293B86E1,$010E7B1C,$191D2FB7,$2C710509,$346251A2,$1C57AC5F,$0444F8F4,
  $0B9B7CCC,$13882867,$3BBDD59A,$23AE8131,$16C2AB8F,$0ED1FF24,$26E402D9,$3EF75672,
  $395B0AA9,$21485E02,$097DA3FF,$116EF754,$2402DDEA,$3C118941,$142474BC,$0C372017,
  $03E8A42F,$1BFBF084,$33CE0D79,$2BDD59D2,$1EB1736C,$06A227C7,$2E97DA3A,$36848E91,
  $3E8A42F7,$2699165C,$0EACEBA1,$16BFBF0A,$23D395B4,$3BC0C11F,$13F53CE2,$0BE66849,
  $0439EC71,$1C2AB8DA,$341F4527,$2C0C118C,$19603B32,$01736F99,$29469264,$3155C6CF,
  $36F99A14,$2EEACEBF,$06DF3342,$1ECC67E9,$2BA04D57,$33B319FC,$1B86E401,$0395B0AA,
  $0C4A3492,$14596039,$3C6C9DC4,$247FC96F,$1113E3D1,$0900B77A,$21354A87,$39261E2C,
  $2E6DF331,$367EA79A,$1E4B5A67,$06580ECC,$33342472,$2B2770D9,$03128D24,$1B01D98F,
  $14DE5DB7,$0CCD091C,$24F8F4E1,$3CEBA04A,$09878AF4,$1194DE5F,$39A123A2,$21B27709,
  $261E2BD2,$3E0D7F79,$16388284,$0E2BD62F,$3B47FC91,$2354A83A,$0B6155C7,$1372016C,
  $1CAD8554,$04BED1FF,$2C8B2C02,$349878A9,$01F45217,$19E706BC,$31D2FB41,$29C1AFEA,
  $1F45217B,$075675D0,$2F63882D,$3770DC86,$021CF638,$1A0FA293,$323A5F6E,$2A290BC5,
  $25F68FFD,$3DE5DB56,$15D026AB,$0DC37200,$38AF58BE,$20BC0C15,$0889F1E8,$109AA543,
  $1736F998,$0F25AD33,$271050CE,$3F030465,$0A6F2EDB,$127C7A70,$3A49878D,$225AD326,
  $2D85571E,$359603B5,$1DA3FE48,$05B0AAE3,$30DC805D,$28CFD4F6,$00FA290B,$18E97DA0,
  $0FA290BD,$17B1C416,$3F8439EB,$27976D40,$12FB47FE,$0AE81355,$22DDEEA8,$3ACEBA03,
  $35113E3B,$2D026A90,$0537976D,$1D24C3C6,$2848E978,$305BBDD3,$186E402E,$007D1485,
  $07D1485E,$1FC21CF5,$37F7E108,$2FE4B5A3,$1A889F1D,$029BCBB6,$2AAE364B,$32BD62E0,
  $3D62E6D8,$2571B273,$0D444F8E,$15571B25,$203B319B,$38286530,$101D98CD,$080ECC66);

type
  THash = record
   A, B, C, D: Longword;
  end;

function Hash         (const Buffer; const Size: Longword): THash;
function HashStr      (const Str     : String  ): THash;
function HashInt      (const Int     : Integer ): THash;
function HashFile     (const FilePath: String  ): THash;
function HashToString (const Hash    : THash   ): String;
function StringToHash (const Str     : String  ): THash;
function SameHash     (const A, B    : THash   ): Boolean;
function HashCrypt    (const Hash    : String;  Key: Integer): String;
function HashUncrypt  (const Hash    : String;  Key: Integer): String;
function IsHash       (const Hash    : String  ): Boolean;

implementation

function Hash(const Buffer; const Size: Longword): THash;
Var
 V: PByte;
 E: Pointer;
begin
 Move(HashTable, Result, 16);
 if Size = 0 then Exit;
 V := @Buffer;
 E := Ptr(Longword(@Buffer) + Size);

 with Result do
  repeat
   begin
    A := (A shl 5) xor (D shr  2) and V^ + B;
    B := (B shl 2) xor (C shr 11) and V^ + A;
    C := (C shl 7) xor (A shr  4) and V^ + D;
    D := (D shl 8) xor (B shr 14) and V^ + C;
    Inc(A, (HashTransform[V^] xor D) + (C xor (D or (not B))));
    Inc(B, (HashTransform[V^] xor C) + (D xor (B or (not A))));
    Inc(C, (HashTransform[V^] xor B) + (A xor (C or (not D))));
    Inc(D, (HashTransform[V^] xor A) + (B xor (A or (not C))));
    Inc(V);
   end
  until V = E;
end;

function HashStr(const Str: String): THash;
Var
 S: array of Char;
 I: Integer;
begin
 SetLength(S, Length(Str));
 for I := 1 to Length(Str) do S[I - 1] := Str[I];
 Result := Hash(S[0], Length(Str));
end;

function HashInt(const Int: Integer): THash;
begin
 Result := Hash(Int, SizeOf(Integer));
end;

function HashFile(const FilePath: String): THash;
Var
 H, M: Longword;
 P: Pointer;
begin
 ZeroMemory(@Result, 16);
 H := CreateFile(PChar(FilePath), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
                 nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);

 if H = INVALID_HANDLE_VALUE then Exit;
 if GetFileSize(H, nil) = 0 then
  begin
   Result := Hash('', 0);
   CloseHandle(H);
   Exit;
  end;

 try
  M := CreateFileMapping(H, nil, PAGE_READONLY, 0, 0, nil);
  try
   if M = 0 then Exit;
   P := MapViewOfFile(M, FILE_MAP_READ, 0, 0, 0);
   try
    if P = nil then Exit;
    Result := Hash(P^, GetFileSize(H, nil));
   finally
   UnmapViewOfFile(P);
   end;
  finally
   CloseHandle(M);
  end;
 finally
  CloseHandle(H);
 end;
end;

function HashToString(const Hash: THash): String;
begin
 Result := Format('%.8x%.8x%.8x%.8x', [Hash.A, Hash.B, Hash.C, Hash.D]);
end;

function StringToHash(const Str: String): THash;
begin
 if IsHash(Str) then
  with Result do
   begin
    A := StrToInt(Format('$%s', [Copy(Str, 1, 8)]));
    B := StrToInt(Format('$%s', [Copy(Str, 9, 8)]));
    C := StrToInt(Format('$%s', [Copy(Str, 17, 8)]));
    D := StrToInt(Format('$%s', [Copy(Str, 25, 8)]));
   end
 else ZeroMemory(@Result, 16);
end;

function SameHash(const A, B: THash): Boolean;
begin
 Result := (A.A = B.A) and (A.B = B.B) and (A.C = B.C) and (A.D = B.D);
end;

const
 Z = #0;

function hxinc(X: Char): Char;
const
 XInc: array [48..70] of Char = ('1', '2', '3', '4', '5', '6', '7', '8', '9', 'A',
                                 Z, Z, Z, Z, Z, Z, Z, 'B', 'C', 'D', 'E', 'F', '0');
begin
 if ord(X) in [48..57, 65..70] then Result := XInc[ord(X)] else Result := Z;
end;

function hxdec(X: Char): Char;
const
 XDec: array [48..70] of Char = ('F', '0', '1', '2', '3', '4', '5', '6', '7', '8',
                                 Z, Z, Z, Z, Z, Z, Z, '9', 'A', 'B', 'C', 'D', 'E');
begin
 if ord(X) in [48..57, 65..70] then Result := XDec[ord(X)] else Result := Z;
end;

function HashCrypt(const Hash: String; Key: Integer): String;
Var
 I, J: Integer;
 S: ShortString;
 P: Integer;
begin
 Result := '';
 if not IsHash(Hash) then Exit;
 Result := Uppercase(Hash);
 S := IntToStr(Key);
 P := 0;
 for I := 1 to Length(Hash) do
  begin
   Inc(P);
   if P = Length(S) + 1 then P := 1;
   for J := 1 to StrToInt(S[P]) do Result[I] := hxinc(Result[I]);
  end;
end;

function HashUncrypt(const Hash: String; Key: Integer): String;
Var
 I, J: Integer;
 S: ShortString;
 P: Integer;
begin
 Result := '';
 if not IsHash(Hash) then Exit;
 Result := Uppercase(Hash);
 S := IntToStr(Key);
 P := 0;
 for I := 1 to Length(Hash) do
  begin
   Inc(P);
   if P = Length(S) + 1 then P := 1;
   for J := 1 to StrToInt(S[P]) do Result[I] := hxdec(Result[I]);
  end;
end;

function IsHash(const Hash: String): Boolean;
Var
 I: Integer;
begin
 Result := False;
 if Length(Hash) <> 32 then Exit;
 for I := 1 to 32 do if not (Hash[I] in ['0'..'9', 'A'..'F', 'a'..'f']) then Exit;
 Result := True;
end;

end.

Unit Counters.pas

unit Counters;

interface

uses Windows, SysUtils;

const
  SECONDS      = 1;
  MILLISECONDS = 1000;
  MICROSECONDS = 1000000;
  NANOSECONDS  = 1000000000;

type
  _COUNTER = record
   Precision: Longword;
   Value: Extended;
  end;

  PCounter = ^_COUNTER;

function InitializeCounter(Precision: Longword): PCounter;
function ResetCounter(Counter: PCounter): Boolean;
function ChangePrecision(Counter: PCounter; NewPrec: Longword): Boolean;
function QueryCounter(Counter: PCounter): Extended;
function GetCounterPrecision(Counter: PCounter): Longword;
function ReleaseCounter(Counter: PCounter): Boolean;

type
 TCounter = class
 private
  FCounter: PCounter;
  function GetValue: Extended;
  function GetPrecision: Longword;
  procedure SetPrecision(Value: Longword);
 public
  constructor Create(Precision: Longword); reintroduce;
  destructor Destroy; override;
  procedure Reset;
  property Value: Extended    read GetValue;
  property Precision: Longword read GetPrecision write SetPrecision;
 end;

Var
 HighResFound: Boolean;
 Tmp: PInt64;

implementation

function GetTckCount(Precision: Longword): Extended;
Var
 Freq, Bgn: Int64;                 
begin
 if not HighResFound then
  begin
   Result := 0;
   if Precision <= 1000 then Result := GetTickCount div Abs(Precision - 999);
   Exit;
  end;

 QueryPerformanceFrequency(Freq);
 QueryPerformanceCounter(Bgn);
 Result := Bgn * Precision / Freq;
end;

function InitializeCounter(Precision: Longword): PCounter;
begin
 New(Result);
 ChangePrecision(Result, Precision);
end;

function ResetCounter(Counter: PCounter): Boolean;
begin
 Result := Assigned(Counter);

 if Result then
  with Counter^ do
   Value := GetTckCount(Precision);
end;

function ChangePrecision(Counter: PCounter; NewPrec: Longword): Boolean;
begin
 Result := False;

 if Assigned(Counter) then
  begin
   if NewPrec = Counter.Precision then Exit;
   Counter.Precision := NewPrec;
   Result := ResetCounter(Counter);
  end;
end;

function QueryCounter(Counter: PCounter): Extended;
begin
 Result := 0;

 if Assigned(Counter) then
  with Counter^ do
   Result := GetTckCount(Precision) - Value;
end;

function GetCounterPrecision(Counter: PCounter): Longword;
begin
 Result := High(Longword);
 if Assigned(Counter) then Result := Counter.Precision;
end;

function ReleaseCounter(Counter: PCounter): Boolean;
begin
 Result := Assigned(Counter);
 if Result then Dispose(Counter);
end;


constructor TCounter.Create(Precision: Longword);
begin
 inherited Create;
 FCounter := InitializeCounter(Precision);
end;

destructor TCounter.Destroy;
begin
 ReleaseCounter(FCounter);
 inherited Destroy;
end;

procedure TCounter.Reset;
begin
 ResetCounter(FCounter);
end;

function TCounter.GetValue: Extended;
begin
 Result := QueryCounter(FCounter);
end;

function TCounter.GetPrecision: Longword;
begin
 Result := GetCounterPrecision(FCounter);
end;

procedure TCounter.SetPrecision(Value: Longword);
begin
 ChangePrecision(FCounter, Value);
end;





initialization
  New(Tmp);
  HighResFound := QueryPerformanceCounter(Tmp^);
  Dispose(Tmp);
  { Si QueryPerformanceCounter renvoie True, vous pourrez utiliser toutes les fonctions du compteur.
    Sinon, vous ne pourrez pas utiliser les très petites précisions et vous aurez une précision
    moindre sur les millisecondes.
    Mais rassurez-vous, de nos jours tous les PC ont des horloges haute précision ! :p       }

end.

Unit1 :

uses LEA_Hash, Counters

//

var
  Form1: TForm1;
  Counter: TCounter;

//

procedure TForm1.FormCreate(Sender: TObject);
begin
 Counter := TCounter.Create(MILLISECONDS);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Counter.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
 MB = 1024 * 1024;
Var
 I: Integer;
 FH, S: Longword;
 H, N, Sz: String;
 T: Single;
 TS: String;
begin
 if OpenDlg.Execute then
  for I := 0 to OpenDlg.Files.Count - 1 do
  begin
   FH := CreateFile(PChar(OpenDlg.Files.Strings[I]), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
                    nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);

   if FH = INVALID_HANDLE_VALUE then Exit else
    begin
     S := GetFileSize(FH, nil);
     CloseHandle(FH);
    end;

   Sz := Format('%d byte', [S]);
   if S > 1024 then Sz := Format('%d Kb', [S div 1024]);
   if S > MB then   Sz := Format('%d Mb', [S div MB]);

   Counter.Reset;
   H := HashToString(HashFile(OpenDlg.Files.Strings[I]));
   T := Counter.Value;

   TS := Format('%.2f ms', [T]);
   if T > 1000 then TS := Format('%.2f s', [T / 1000]);

   N := ExtractFileName(OpenDlg.Files.Strings[I]);
   with ListView1.Items.Add do
    begin
     Caption := N;
     SubItems.Add(Sz);
     SubItems.Add(H);
     SubItems.Add(TS);
    end;
  end;
end;

hackbard

LEA-128 Hash Calculator

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate