Algoritmos de encriptacion md5 o sh1 en delphi

Saludos amigos; en esta oportunidad hablaremos de Algoritmos de encriptacion en delphi lo que se nos vuelve en una necesidad al momento de implementar una aplicacion con base de datos que almacene contraseñas, otro aspecto resaltar es que estos algoritmos son en un solo sentido lo que quiere decir que al momento de hacer login, solo debes encriptar el contenido del campo clave y compararlo con el amacenado previamente en la base de datos.

A continuacion muestro la unit con el nombre de Hashes que contiene los algoritmos de encriptacion md5 y sh1 la cual solo tienes que agregar a la clausula uses de la unidad donde estes encriptando datos.
Asi: 
...
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Hashes;//aqui...

{$R *.dfm}

...
En este ejemplo es Form1 en el cual yo tengo el campo de texto y los demas componentes para mostrar los textos encriptados con los dos algorimos esa clausula se encuentra en la parte publica del documento justo debajo de . implementation.

El contenido de la unidad es el siguiente:

unit Hashes;

interface

uses Windows, SysUtils, Classes;

type
  THashAlgorithm = (haMD5, haSHA1);

function CalcHash(Stream: TStream; Algorithm: THashAlgorithm): string; overload;
function CalcHash(Archivo: string; Algorithm: THashAlgorithm): string; overload;
function CalcHash2(Str: string; Algorithm: THashAlgorithm): string;

implementation

type
  HCRYPTPROV = ULONG;
  PHCRYPTPROV = ^HCRYPTPROV;
  HCRYPTKEY = ULONG;
  PHCRYPTKEY = ^HCRYPTKEY;
  HCRYPTHASH = ULONG;
  PHCRYPTHASH = ^HCRYPTHASH;
  LPAWSTR = PAnsiChar;
  ALG_ID = ULONG;

const
  CRYPT_NEWKEYSET = $00000008;
  PROV_RSA_FULL = 1;
  CALG_MD5 = $00008003;
  CALG_SHA1  = $00008004;
  HP_HASHVAL = $0002;

function CryptAcquireContext(phProv: PHCRYPTPROV;
  pszContainer: LPAWSTR;
  pszProvider: LPAWSTR;
  dwProvType: DWORD;
  dwFlags: DWORD): BOOL; stdcall;
  external ADVAPI32 name 'CryptAcquireContextA';

function CryptCreateHash(hProv: HCRYPTPROV;
  Algid: ALG_ID;
  hKey: HCRYPTKEY;
  dwFlags: DWORD;
  phHash: PHCRYPTHASH): BOOL; stdcall;
  external ADVAPI32 name 'CryptCreateHash';

function CryptHashData(hHash: HCRYPTHASH;
  const pbData: PBYTE;
  dwDataLen: DWORD;
  dwFlags: DWORD): BOOL; stdcall;
  external ADVAPI32 name 'CryptHashData';

function CryptGetHashParam(hHash: HCRYPTHASH;
  dwParam: DWORD;
  pbData: PBYTE;
  pdwDataLen: PDWORD;
  dwFlags: DWORD): BOOL; stdcall;
  external ADVAPI32 name 'CryptGetHashParam';

function CryptDestroyHash(hHash: HCRYPTHASH): BOOL; stdcall;
  external ADVAPI32 name 'CryptDestroyHash';

function CryptReleaseContext(hProv: HCRYPTPROV; dwFlags: DWORD): BOOL; stdcall;
  external ADVAPI32 name 'CryptReleaseContext';

function CalcHash(Stream: TStream; Algorithm: THashAlgorithm): string; overload;
var
  hProv: HCRYPTPROV;
  hHash: HCRYPTHASH;
  Buffer: PByte;
  BytesRead: DWORD;
  Algid: ALG_ID;
  Data: array[1..20] of Byte;
  DataLen: DWORD;
  Success: BOOL;
  i: integer;
begin
  Result:= EmptyStr;
  Success := CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, 0);
  if (not Success) then
    if GetLastError() = DWORD(NTE_BAD_KEYSET) then
      Success := CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL,
        CRYPT_NEWKEYSET);
  if Success then
  begin
    if Algorithm = haMD5 then
    begin
      Algid:= CALG_MD5;
      Datalen:= 16
    end else
    begin
      Algid:= CALG_SHA1;
      Datalen:= 20;
    end;
    if CryptCreateHash(hProv, Algid, 0, 0, @hHash) then
    begin
      GetMem(Buffer,10*1024);
      try
        while  TRUE do
        begin
          BytesRead:= Stream.Read(Buffer^, 10*1024);
          if (BytesRead = 0) then
          begin
            if (CryptGetHashParam(hHash, HP_HASHVAL, @Data, @DataLen, 0)) then
              for i := 1 to DataLen do
                Result := Result + LowerCase(IntToHex(Integer(Data[i]), 2));
            break;
          end;
          if (not CryptHashData(hHash, Buffer, BytesRead, 0)) then
            break;
        end;
      finally
        FreeMem(Buffer);
      end;
      CryptDestroyHash(hHash);
    end;
    CryptReleaseContext(hProv, 0);
  end;
end;

function CalcHash(Archivo: string; Algorithm: THashAlgorithm): string; overload;
var
  Stream: TFileStream;
begin
  Result:= EmptyStr;
  if FileExists(Archivo) then
  try
    Stream:= TFileStream.Create(Archivo,fmOpenRead or fmShareDenyWrite);
    try
      Result:= CalcHash(Stream,Algorithm);
    finally
      Stream.Free;
    end;
  except end;
end;

function CalcHash2(Str: string; Algorithm: THashAlgorithm): string;
var
  Stream: TStringStream;
begin
  Result:= EmptyStr;
  Stream:= TStringStream.Create(Str);
  try
    Result:= CalcHash(Stream,Algorithm);
  finally
    Stream.Free;
  end;
end;

end.

La forma de llamar esta funcion es la siguiente (Basandome en el ejemplo que expongo) es la siguiente:

  // md5
  label4.Caption:=CalcHash2(Edit1.Text,haMD5);

  // sha1
  label5.Caption:=CalcHash2(Edit1.Text,haSHA1);

De todas formas dejo el proyecto completo para descargarlo.

Deja tu comentario o agracdecimiento...