09-06-2011, 09:45 PM
لماذا تظهر النتيجة خطا
استخدم DXE
استخدم DXE
PHP كود :
const
PROV_RSA_FULL = 1;
CRYPT_VERIFYCONTEXT = 4026531840;
CALG_MD5 = 32771;
HP_HASHVAL = 2;
ADVAPI32 = 'advapi32.dll';
type
HCRYPTPROV = ULONG;
PHCRYPTPROV = ^HCRYPTPROV;
HCRYPTHASH = ULONG;
PHCRYPTHASH = ^HCRYPTHASH;
ALG_ID = ULONG;
HCRYPTKEY = ULONG;
PHCRYPTKEY = ^HCRYPTKEY;
function CryptAcquireContext(phProv: PHCRYPTPROV; pszContainer: PAnsiChar;
pszProvider: PAnsiChar; dwProvType: DWORD; dwFlags: DWORD): BOOL; stdcall;
external ADVAPI32 name 'CryptAcquireContextA';
function CryptReleaseContext(hProv: HCRYPTPROV; dwFlags: DWORD): BOOL; stdcall;
external ADVAPI32 name 'CryptReleaseContext';
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 CalcMD5(const AString: string): string;
var
hProv: HCRYPTPROV;
hHash: HCRYPTHASH;
pBuff, p: PBYTE;
i, ALen: Cardinal;
begin
Result := '';
pBuff := nil;
if CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL,
CRYPT_VERIFYCONTEXT) then
try
if CryptCreateHash(hProv, CALG_MD5, 0, 0, @hHash) then
begin
if CryptHashData(hHash, @AString[1], Length(AString), 0) then
begin
if CryptGetHashParam(hHash, HP_HASHVAL, nil, @ALen, 0) then
begin
GetMem(pBuff, ALen);
p := pBuff;
if CryptGetHashParam(hHash, HP_HASHVAL, pBuff, @ALen, 0) then
for i := 1 to ALen do
begin
Result := Result + IntToHex(p^, 2);
Inc(p);
end;
end;
end;
end;
finally
if Assigned(pBuff) then
FreeMem(pBuff, ALen);
CryptDestroyHash(hHash);
CryptReleaseContext(hProv, 0);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := CalcMD5('delphi4arab');
end;