Cita:
Empezado por juramisa
¿Serías tan amable de mandarme ese procedimiento en la versión Rio?. Viéndolo, parece que es un problema al cargar la lista de los certificados presentes en el ordenador.
¿Tal vez hay una orden previa para la carga de los certificados y que yo no la esté realizando?
Gracias.
|
Te lo envío, pero sigo creyendo que éste no es el problema, el problema lo tienes en otra parte.
Código Delphi
[-]
procedure TWinHTTPClient.DoGetClientCertificates(const ARequest: THTTPRequest;
const ACertificateList: TList);
var
LRequest: TWinHTTPRequest;
LStore: HCERTSTORE;
LIssuerList: PSecPkgContext_IssuerListInfoEx;
LClientCert: PCCERT_CONTEXT;
LSearchCriteria: CERT_CHAIN_FIND_BY_ISSUER_PARA;
LIssuerListSize: DWORD;
LPrevChainContext, LClientCertChain: PCCERT_CHAIN_CONTEXT;
procedure AddToCertificateList(const AClientCert: PCCERT_CONTEXT);
var
LCertificate: TCertificate;
begin
CertDuplicateCertificateContext(AClientCert); CryptCertToTCertificate(AClientCert, LCertificate);
FCertificateList.Add(LCertificate);
FWinCertList.Add(AClientCert);
end;
begin
inherited;
if FWinCertList.Count = 0 then
begin
LRequest := TWinHTTPRequest(ARequest);
LIssuerList := nil;
LIssuerListSize := SizeOf(LIssuerList);
LStore := TWinHttpLib.GetCertStore;
if WinHttpQueryOption(LRequest.FWRequest, WINHTTP_OPTION_CLIENT_CERT_ISSUER_LIST, LIssuerList, LIssuerListSize) and (LIssuerList <> nil) then
begin
FillChar(LSearchCriteria, SizeOf(LSearchCriteria), 0);
LSearchCriteria.cbSize := SizeOf(LSearchCriteria);
LSearchCriteria.cIssuer := LIssuerList.cIssuers;
LSearchCriteria.rgIssuer := LIssuerList.aIssuers;
if LStore <> nil then
begin
LPrevChainContext := nil;
while True do
begin
LClientCertChain := CertFindChainInStore(LStore, X509_ASN_ENCODING,
CERT_CHAIN_FIND_BY_ISSUER_CACHE_ONLY_URL_FLAG or CERT_CHAIN_FIND_BY_ISSUER_CACHE_ONLY_FLAG,
CERT_CHAIN_FIND_BY_ISSUER, @LSearchCriteria, LPrevChainContext);
if LClientCertChain <> nil then
begin
LPrevChainContext := LClientCertChain;
LClientCert := LClientCertChain.rgpChain^.rgpElement^.pCertContext;
AddToCertificateList(LClientCert);
end else
Break;
end;
end;
GlobalFree(HGLOBAL(LIssuerList));
end else
begin
if LStore <> nil then
begin
LClientCert := nil;
while True do
begin
LClientCert := CertFindCertificateInStore(LStore,
X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
0, CERT_FIND_ANY, nil, LClientCert);
if LClientCert <> nil then
AddToCertificateList(LClientCert)
else
Break;
end;
end;
end;
end;
ACertificateList.Clear;
ACertificateList.AddRange(FCertificateList);
end;