Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Internet
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

 
 
Herramientas Buscar en Tema Desplegado
  #11  
Antiguo 05-11-2020
Avatar de elcharlie
elcharlie elcharlie is offline
Miembro
 
Registrado: mar 2013
Ubicación: Bilbao
Posts: 174
Poder: 12
elcharlie Va por buen camino
Cita:
Empezado por juramisa Ver Mensaje
¿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); // Need to be released (CertFreeCertificateContext)
    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;
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
SII -Nuevo sistema de la Agencia Tributaria española de envío de datos vía Webservice newtron Internet 3565 Hace 2 Días 11:04:13
Como utilizar la ayuda del nuevo Sistema Operativo gluglu Humor 3 24-09-2007 09:39:05
Aplicacion Agencia De Viajes ArdiIIa Varios 9 20-01-2007 16:49:53
El Vasco Aguirre Al González La Taberna 5 26-05-2006 09:22:28
Microsoft ha lanzado su nuevo sistema operativo DarkByte Humor 0 25-01-2004 09:21:14


La franja horaria es GMT +2. Ahora son las 02:25:05.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi