Calcular hash sha1 y md5

En un artículo anterior mostraba como calcular el hash md5. Partiendo del código que mostraba en ese articulo, añadiremos la posibilidad de calcular el hash sha1 además del md5. Se usan las mismas funciones de la API, solo se hacen algunos ajustes para poder usar ambos algoritmos.

Es una unit (Hashes.pas)

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.

Ejemplos de uso:

  // sha1
  ShowMessage(CalcHash2('The quick brown fox jumps over the lazy dog',haSHA1));
  // md5
  ShowMessage(CalcHash2('The quick brown fox jumps over the lazy dog',haMD5));

Comentarios

Y dar soporte a una barrita de progreso para archivos grandes... ¿seria muy complicado?

Precisamente David, un compañero del clubdelphi, ha creado un componente (THashes) a partir de la unidad hashes. Entre otras cosas, el componente tiene el evento OnWork que es perfecto para actualizar una barra de progreso.

El componente lo puedes descargar de aquí, aunque no se cuanto tiempo estará disponible:
http://www.terawiki.com/clubdelphi/Delphi-Win32/Componentes/

Muchísimas GRACIAS de corazón por mostrarnos este código. Me necuentro programando en mi web un TPV VIRTUAL y necesito calcular la firma con SHA1.

Tu código funciona de maravilla.

Saludos

¿ Funciona en delphi xe2 64 bits ?

Saludos,
Javier

No puedo comprobarlo ya que no dispongo de esa versión de Delphi, pero no veo porque no va a funcionar. El único problema que se nos podrida plantear es si calculas el hash de un String que en esa versión de delphi son unicode, y por lo tanto ocupan 2 bytes y no 1 por lo que el hash sera diferente. Pero si utilizas el tipo AnsiString en vez de Strings deberías de obtener buenos resultados.

Por otro lado aqui explico como calcular el hash SHA256 sin usar la API de windows, solo con codigo en Pascal:
http://delphi.jmrds.com/?q=node/64

Y aquí explico como modificar las funciones en ensamblador que aparecen en el código anterior para compilarlo en cualquier compilador de pascal, incluso en un teléfono móvil:
http://delphi.jmrds.com/?q=node/73

Saludos

Gracias admin por la pronta contestación.

Lo he probado en una aplicación webbroker 64 y también 32 bits y el resultado es una cadena nula. Si es una aplicación vcl 32 de escritorio, el resultado es correcto. También he probado hacer un typecast con AnsiString(Data) y el resultado es el mismo.

El código es el siguiente :

procedure TWebModule1.WebModule1sha1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
    Response.ContentType := 'text/html';
    Response.Content := CalcHash2(AnsiString(Request.QueryFields.Values['src']),haSHA1);
    Handled := true;
end;

y el otro código (que también devuelve nil es:

    ParaHash := Amount + Order + Code + Currency + TransactionType + Url + Password;
    Signature:= CalcHash2(ParaHash,haSHA1);

Mañana probaré los enlaces que comentas y te diré el resultado.
Muchas gracias por la información.

Al parecer la función CryptAcquireContext tiene problemas si se llama desde un servicio. Quizá debas buscar información por ese lado.

O como ya te comente antes, utilizar otras funciones que no dependan tanto del sistema operativo, como por ejemplo el hash SHA256 que te deje mas arriba.

Saludos

Hola de nuevo :

Tenías razón. Es un problema de permisos del usuario IUSR_xxxx al llamar a CryptAcquireContext. Por otro lado, para mi funciona tanto con string como con AnsiString.
Muchas gracias por tu ayuda,

Javier

Para que funcione en ISAPI dll, tanto 32 como 64 bits, debemos hacer estas modificaciones en la unidad

Hashes,pas :
1.) Definir una constante nueva
const
  CRYPT_VERIFYCONTEXT   = $F0000000;
2.) Modificar la línea comentada por la que pongo debajo en la función :
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);
  Success := CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL,CRYPT_VERIFYCONTEXT);

Funciona perfecto tanto para archivos como para cadenas de texto, lo he probado en lazarus en lugar de la unidad dcpsha1.pas que vienen en esa plataforma, ambas entregan el mismo resultado, pero...
Como hacer para que el resultado lo entregue en base64 en lugar de hex ??

Puedes usar la unit base64 que puedes encontrar aquí:
http://delphi.jmrds.com/?q=node/43

Tendrías que modificar estas lineas en la función CalcHash:

          if (CryptGetHashParam(hHash, HP_HASHVAL, @Data, @DataLen, 0)) then
              for i := 1 to DataLen do
                Result := Result + LowerCase(IntToHex(Integer(Data[i]), 2));

Por algo como esto:

          if (CryptGetHashParam(hHash, HP_HASHVAL, @Data, @DataLen, 0)) then
             Result:= BinToStr(@Data,DataLen);

Pruebalo y nos cuentas

Saludos

Excelente tutorial.. ahora cual es mejor para utilizar encriptacion SHA1 o MD5 para un sistema de registro de pagos mediante boletas??? Que me recomendas que utilice.
Gracias por tu información.

Si me dices que algoritmo de hash es mejor, yo te recomiendo SHA256 o superior.
http://delphi.jmrds.com/?q=node/88

Saludos

Añadir nuevo comentario