unit1.pas

Delphi Cryptographic API Hash example using MD2 MD4 MD5 SHA1 GOST

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  Wcrypt2;

function BinToHex(Buffer: Pointer; Size: Integer): string;
const
  Convert: array[0..15] of Char = '0123456789abcdef';
var
  p: PByte;
begin
  Result := '';
  p := PByte(Buffer);
  while Size > 0 do
  begin     
    Result := Result + Convert[p^ shr 4] + Convert[p^ and 15];
    Inc(p);
    Dec(Size);
  end;
end;

function ComputeHash(Buffer: Pointer; Size: Integer;
  ProvType: Cardinal; AlgId: ALG_ID): string;
var
  hProv: HCRYPTPROV;
  hHash: HCRYPTHASH;
  cbHash: Cardinal;
  pbHash: Pointer;
begin
  Result := '';
  if CryptAcquireContext(@hProv, nil, nil, ProvType, CRYPT_VERIFYCONTEXT) then
  begin
    try 
      if CryptCreateHash(hProv, AlgId, 0, 0, @hHash) then
      begin
        try
          if CryptHashData(hHash, PByte(Buffer), Size, 0) then
          begin
            if CryptGetHashParam(hHash, HP_HASHVAL, nil, @cbHash, 0) then
            begin
              GetMem(pbHash, cbHash);
              try
                if CryptGetHashParam(hHash, HP_HASHVAL, pbHash, @cbHash, 0) then
                begin
                  Result := BinToHex(pbHash, cbHash);
                end;
              finally
                FreeMem(pbHash, cbHash);
              end;
            end;
          end;
        finally
          CryptDestroyHash(hHash);
        end;
      end;
    finally
      CryptReleaseContext(hProv, 0);
    end;
  end;
end;

const
  PROV_GOST_94_DH = 71;
  PROV_GOST_2001_DH = 75;
  CALG_GR3411 = ALG_CLASS_HASH or ALG_TYPE_ANY or 30;

procedure TForm1.Button1Click(Sender: TObject);
var
  Value: string;
begin
  if InputQUery('', 'Enter a string for hashing', Value) then
  begin
    if (Value <> '') then
    begin
      ShowMessage('MD2 : ' + ComputeHash(PChar(Value), Length(Value), PROV_RSA_FULL, CALG_MD2));
      ShowMessage('MD4 : ' + ComputeHash(PChar(Value), Length(Value), PROV_RSA_FULL, CALG_MD4));
      ShowMessage('MD5 : ' + ComputeHash(PChar(Value), Length(Value), PROV_RSA_FULL, CALG_MD5));
      ShowMessage('SHA1 : ' + ComputeHash(PChar(Value), Length(Value), PROV_RSA_FULL, CALG_SHA1));
      ShowMessage('GOST R34.11-94 : ' + ComputeHash(PChar(Value), Length(Value), PROV_GOST_94_DH, CALG_GR3411));
    end;
  end;
end;

end.