Внес изменения, вроде работает, но явно все равно что-то не так.
Вот код:
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.
//----- Найти сертификат в хранилище 'MY' по SHA1 HASH ---------------
function Cert_FindCertificate_BySHA1(SHA1: PWideChar; aCertStore: Pointer): PCCERT_CONTEXT; stdcall;
var
blob: CRYPT_HASH_BLOB;
begin
blob.cbData := 20;
blob.pbData := GetMemory(blob.cbData);
HexToBin(PWideChar(SHA1), blob.pbData, blob.cbData);
try
Result := CertFindCertificateInStore(
aCertStore,
X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
0,
CERT_FIND_SHA1_HASH,
@blob,
nil
);
finally
FreeMemory(blob.pbData);
end;
end;
//----- Проверить цепочку сертификатов ---------------
function GetCertificateChain_Status(pCertContext: PCCERT_CONTEXT): Boolean;
var
ChainConfig: CERT_CHAIN_ENGINE_CONFIG;
phChainEngine: HCERTCHAINENGINE;
vChainPara: CERT_CHAIN_PARA;
dwFlags: DWORD;
pChainContext: PCCERT_CHAIN_CONTEXT;
flgChainCreated: Boolean;
vCertStore: Pointer;
begin
Result := False;
pChainContext := nil;
ChainConfig.cbSize := sizeof(CERT_CHAIN_ENGINE_CONFIG);
ChainConfig.hRestrictedRoot := nil;
ChainConfig.hRestrictedTrust := nil;
ChainConfig.hRestrictedOther := nil;
ChainConfig.cAdditionalStore := 0;
ChainConfig.rghAdditionalStore := nil;
ChainConfig.dwFlags := CERT_CHAIN_CACHE_END_CERT;
ChainConfig.dwUrlRetrievalTimeout := 0;
ChainConfig.MaximumCachedCertificates := 0;
ChainConfig.CycleDetectionModulus := 0;
vChainPara.cbSize := SizeOf(CERT_CHAIN_PARA);
if not CertCreateCertificateChainEngine(@ChainConfig, phChainEngine) then
EXIT;
dwFlags := CERT_CHAIN_CACHE_END_CERT;
flgChainCreated := CertGetCertificateChain( // <--- Здесь происходит AV
phChainEngine,
pCertContext,
nil,
nil,
@vChainPara,
dwFlags,
nil,
@pChainContext
);
if flgChainCreated then
Result := pChainContext^.TrustStatus.dwErrorStatus = CERT_TRUST_NO_ERROR;
if pChainContext <> nil then
CertFreeCertificateChain(pChainContext);
CertFreeCertificateChainEngine(phChainEngine);
end;
//----- Проверим работу функции проверки цепочки сертификтов ---------------
procedure TfrmMain.Button1Click(Sender: TObject);
var
vCertStore: Pointer;
vCertContext: PCCERT_CONTEXT;
begin
// откроем хранилище и найдем сертификат
vCertStore := CertOpenSystemStore( 0, PChar( 'MY' ));
vCertContext := Cert_FindCertificate_BySHA1(PWideChar( edtSHA1FingerPrint.Text ), vCertStore);
Memo1.Lines.Append(''); // <-- если удалить эту строку, то проискходит AV в GetCertificateChain_Status()
if GetCertificateChain_Status(vCertContext) then
ShowMessage('Ok')
else
ShowMessage('ERROR !');
CertFreeCertificateContext( vCertContext );
CertCloseStore( vCertStore, CERT_CLOSE_STORE_CHECK_FLAG );
end;
Первое - если кликнуть на кнопку Button1 - AV при втором вызове
CertGetCertificateChain
Второе - вообще бред - если удалить строку Memo1.Lines.Append(''); получаем AV при ПЕРВОМ же вызове
CertGetCertificateChain
Т.е. явно где-то лажа, но где?
