23-06-2011, 01:22 PM
لماذا لا يعمل هذا الكود على دلفي 7
مطلوب تحصيح الكود
مطلوب تحصيح الكود
كود :
function Digest(Str1, Passward: string): string;
const
aMicrosoftEnhan =
'Microsoft Enhanced DSS and Diffie-Hellman Cryptographic Provider';
var
hProv: HCRYPTPROV;
hHash: HCRYPTHASH;
hKey: HCRYPTKEY;
hHmacHash: HCRYPTHASH;
pbHash: PByte;
dwDataLen: DWORD;
KeyAsByte: PByte;
CommandAsByte: PByte;
HmacInfo: HMAC_INFO;
i: integer;
Key: ansistring;
// Decoder: TIdDecoderMIME;
// Uri: TidUri;
// Encoding: TEncoding;
Firma: string;
// Encoder: TIdEncoderMIME;
begin
hProv := 0;
hHash := 0;
hKey := 0;
hHmacHash := 0;
pbHash := nil;
dwDataLen := 0;
// Decoder := TIdDecoderMIME.Create;
// Uri := TidUri.Create(Url);
// Encoding := TEncoding.Create;
// Encoder := TIdEncoderMIME.Create;
try
// Key := StringReplace(Base64Key, '-', '+', [rfReplaceAll]);
// Key := StringReplace(Key, '_', '/', [rfReplaceAll]);
KeyAsByte :=PByte(Str1); //PByte(Decoder.DecodeBytes(Key));
CommandAsByte :=PByte(Passward) ;//PByte(Encoding.ASCII.GetBytes(Uri.GetPathAndParams));
ZeroMemory(@HmacInfo, sizeof(HmacInfo));
HmacInfo.HashAlgid := CALG_MD5;
if not CryptAcquireContext(@hProv, nil, aMicrosoftEnhan, PROV_RSA_FULL,
CRYPT_VERIFYCONTEXT) then
raise ESysError.Create('Error in AcquireContext');
if not CryptCreateHash(hProv, CALG_MD5, 0, 0, @hHash) then
raise ESysError.Create('Error in CryptCreateHash');
if not CryptHashData(hHash, @KeyAsByte[0], sizeof(KeyAsByte), 0) then
raise ESysError.Create('Error in CryptHashData');
if not CryptDeriveKey(hProv, CALG_RC2, hHash, CRYPT_EXPORTABLE, @hKey) then
raise ESysError.Create('Error in CryptDeriveKey');
if not CryptCreateHash(hProv, CALG_HMAC, hKey, 0, @hHmacHash) then
raise ESysError.Create('Error in CryptCreateHash');
if not CryptSetHashParam(hHmacHash, HP_HMAC_INFO, @HmacInfo, 0) then
raise ESysError.Create('Error in CryptSetHashParam');
if not CryptHashData(hHmacHash, @CommandAsByte[0],
sizeof(CommandAsByte), 0) then
raise ESysError.Create('Error in CryptHashData 0x%08x');
if not CryptGetHashParam(hHmacHash, HP_HASHVAL, nil, @dwDataLen, 0) then
raise ESysError.Create('Error in CryptGetHashParam');
GetMem(pbHash, dwDataLen);
if not CryptGetHashParam(hHmacHash, HP_HASHVAL, pbHash, @dwDataLen, 0) then
raise ESysError.Create('Error in CryptGetHashParam');
Firma := '';
for i := 0 to dwDataLen - 1 do
Firma := Firma + Format('%.2x', [pbHash[i]]);
// Firma := Encoder.EncodeString(Firma);
// Firma := StringReplace(Firma, '+', '-', [rfReplaceAll]);
// Firma := StringReplace(Firma, '/', '_', [rfReplaceAll]);
result := Firma;
finally
if hHmacHash <> 0 then
CryptDestroyHash(hHmacHash);
if hKey <> 0 then
CryptDestroyKey(hKey);
if hHash <> 0 then
CryptDestroyHash(hHash);
if hProv <> 0 then
CryptReleaseContext(hProv, 0);
if pbHash <> nil then
FreeMem(pbHash);
(* Decoder.Free;
Uri.Free;
Encoding.Free;
Encoder.Free; *)
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Text := 'Key=' + Digest(Edit1.Text, Edit2.Text);
end;