Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 10-05-2007
Avatar de Lepe
[Lepe] Lepe is offline
Miembro Premium
 
Registrado: may 2003
Posts: 7.424
Poder: 28
Lepe Va por buen camino
Calcular hash md5

Dejo la unidad completa:
Código Delphi [-]
Unit md5;

interface

uses
  Windows, Sysutils, Dialogs, Clipbrd;


  function CalculeMd5(Filename: String): string;
implementation

type
  TBuffer = Array[1..10240] of Byte; // 10kb  

  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;
  ALG_TYPE_ANY    = 0;
  ALG_CLASS_HASH  = (4 shl 13);
  ALG_SID_MD5     = 3;
  CALG_MD5        = (ALG_CLASS_HASH or ALG_TYPE_ANY or ALG_SID_MD5);
  HP_HASHVAL      = $0002;

  function SHGetFolderPath(    hwndOwner: HWND;
                               nFolder:   Integer;
                               hToken:    THandle;
                               dwFlags:   DWORD;
                               pszPath:   LPTSTR): HRESULT; stdcall;
    external 'Shell32.dll' name 'SHGetFolderPathA';
  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 CalculeMd5(Filename: String): string;
var
  hFile: THANDLE;
  hProv: HCRYPTPROV;
  hHash: HCRYPTHASH;
  Buffer: TBuffer;
  BytesRead: DWORD;
  Data: array[1..16] of Byte;
  DataLen: DWORD;
  Success: BOOL;
  i: integer;
begin
  Result:= '';
  hFile:= CreateFile(PChar(Filename),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_FLAG_SEQUENTIAL_SCAN,  0);
  if (hFile <> INVALID_HANDLE_VALUE) then
    begin
      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 CryptCreateHash(hProv, CALG_MD5, 0, 0, @hHash) then
            begin
              while (ReadFile(hFile, Buffer, sizeof(Buffer), BytesRead,nil)) do
                begin
                  if (BytesRead = 0) then
                    begin
                      DataLen:= Sizeof(Data);
                      if (CryptGetHashParam(hHash, HP_HASHVAL,@Data,@DataLen,0)) then
                        for i:= 1 to 16 do
                          Result:= Result + IntToHex(Integer(Data[i]),2);
                      break;
                    end;
                  if (not CryptHashData(hHash, @Buffer, BytesRead, 0)) then
                    break;
                end;
              CryptDestroyHash(hHash);
            end;
          CryptReleaseContext(hProv,0);
        end;
      CloseHandle(hFile)
    end;
end;

end.

Saludos

Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 18:57:24.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi