1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
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.
|
