Ver Mensaje Individual
  #317  
Antiguo 05-11-2020
juramisa juramisa is offline
Miembro
 
Registrado: abr 2007
Posts: 54
Reputación: 18
juramisa Va por buen camino
Gracias elcharlie,
El error se da en el siguiente procedimiento de la unit System.Net.HttpClient.Win, marco la instrucción en rojo;

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;
  LCertificate: TCertificate;
begin
  inherited;

  if FWinCertList.Count = 0 then
  begin
    LRequest := TWinHTTPRequest(ARequest);

    LIssuerList := nil;
    LIssuerListSize := SizeOf(LIssuerList);

    if WinHttpQueryOption(LRequest.FWRequest, WINHTTP_OPTION_CLIENT_CERT_ISSUER_LIST, LIssuerList, LIssuerListSize) = TRUE then
    begin
      FillChar(LSearchCriteria, SizeOf(LSearchCriteria), 0);
      LSearchCriteria.cbSize := SizeOf(LSearchCriteria);
      LSearchCriteria.cIssuer := LIssuerList.cIssuers;
      LSearchCriteria.rgIssuer := LIssuerList.aIssuers;

      LStore := TCertificateStore.Store;
      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;
            CertDuplicateCertificateContext(LClientCert); // Need to be released (CertFreeCertificateContext)
            CryptCertToTCertificate(LClientCert, LCertificate);
            FCertificateList.Add(LCertificate);
            FWinCertList.Add(LClientCert);
          end
          else
            Break;
        end;
      end;
      GlobalFree(HGLOBAL(LIssuerList));
    end;
  end;
  ACertificateList.Clear;
  ACertificateList.AddRange(FCertificateList);
end;

¿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.
Responder Con Cita