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: 22
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
  #2  
Antiguo 10-05-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 17
seoane Va por buen camino
Yo la que uso ahora es esta otra unit, que permite calcular el hash (md5) de un archivo, un stream y de una cadena de texto:
Código Delphi [-]
unit Hashes;

interface

uses Windows, SysUtils, Classes;

function CheckSum(Stream: TStream): string; overload;
function CheckSum(Archivo: string): string; overload;
function StrCheckSum(Str: string): 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;
  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 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 CheckSum(Stream: TStream): string; overload;
var
  hProv: HCRYPTPROV;
  hHash: HCRYPTHASH;
  Buffer: PByte;
  BytesRead: DWORD;
  Data: array[1..16] 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 CryptCreateHash(hProv, CALG_MD5, 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
            DataLen := Sizeof(Data);
            if (CryptGetHashParam(hHash, HP_HASHVAL, @Data, @DataLen, 0)) then
              for i := 1 to 16 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 CheckSum(Archivo: string): string; overload;
var
  Stream: TFileStream;
begin
  Result:= EmptyStr;
  if FileExists(Archivo) then
  try
    Stream:= TFileStream.Create(Archivo,fmOpenRead or fmShareDenyWrite);
    try
      Result:= CheckSum(Stream);
    finally
      Stream.Free;
    end;
  except end;
end;

function StrCheckSum(Str: string): string;
var
  Stream: TStringStream;
begin
  Result:= EmptyStr;
  Stream:= TStringStream.Create(Str);
  try
    Result:= CheckSum(Stream);
  finally
    Stream.Free;
  end;
end;

end.
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 22:31:23.


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