Ver Mensaje Individual
  #13  
Antiguo 02-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Reputación: 0
isnagil Va por buen camino
Al final he dejado el evento así:

Código Delphi [-]
function TWinHTTPClient.DoClientCertificateAccepted(const ARequest: THTTPRequest; const AnIndex: Integer): Boolean;
// Cambiamos el contenido del evento por el webservice
{var
  LRequest: TWinHTTPRequest;
begin
  inherited;
  LRequest := TWinHTTPRequest(ARequest);
  Result := WinHttpSetOption(LRequest.FWRequest, WINHTTP_OPTION_CLIENT_CERT_CONTEXT, FWinCertList[AnIndex], SizeOf(CERT_CONTEXT) );}
procedure CheckError(Puntero: Pointer);
  begin
    if not Assigned(Puntero) then
      RaiseLastOSError;
  end;

const
  CERT_COMPARE_HAS_PRIVATE_KEY = 21;
  PKCS12_INCLUDE_EXTENDED_PROPERTIES  = $0010;
  CERT_FIND_HAS_PRIVATE_KEY = CERT_COMPARE_HAS_PRIVATE_KEY shl CERT_COMPARE_SHIFT;

  Pass = 'XXXXXXXXX';
var
  pStore: HCERTSTORE;
  pCert: PCERT_CONTEXT;
  DataBlob: CRYPT_BIT_BLOB;
  PFX: TBytes;

  LRequest: TWinHTTPRequest;
begin
  pStore := nil;
  pCert := nil;

  PFX := TFile.ReadAllBytes('XXXXXXXXXXXXXXXX.pfx');
  // Se comprueba que existe el certificado
  {if not FileExists(ExtractFilePath(Application.ExeName) + 'XXXXXXXXXXXXXXXX.pfx') then
  begin
    Showmessage('El nombre del certificado es incorrecto o no se encuentra');
    Exit;
  end;

  PFX := TFile.ReadAllBytes(ExtractFilePath(Application.ExeName) + 'XXXXXXXXXXXXXXXX.pfx');}

  try
    DataBlob.cbData := Length(PFX);
    DataBlob.pbData := @PFX[0];

    // Almacen temporal con el contenido del PFX
    pStore := PFXImportCertStore(DataBlob, PWideChar(Pass), PKCS12_INCLUDE_EXTENDED_PROPERTIES);
    CheckError(pStore);

    // Buscar un certificado con clave privada
    // Solo debería haber uno
    pCert := CertFindCertificateInStore(pStore,
                                        X509_ASN_ENCODING,
                                        0,
                                        CERT_FIND_HAS_PRIVATE_KEY, //CERT_FIND_ANY,
                                        nil,
                                        nil);
    CheckError(pCert);

    // Pasarlo al servicio, aquí está el equivalente al antiguo data
    LRequest := TWinHTTPRequest(ARequest);
    Result := WinHttpSetOption(LRequest.FWRequest, WINHTTP_OPTION_CLIENT_CERT_CONTEXT, pCert, SizeOf(CERT_CONTEXT));
  finally
    if Assigned(pCert) then
      CertFreeCertificateContext(pCert);

    if Assigned(pStore) then
      CertCloseStore(pStore, 0);
  end;
end;

Quería comprobar que existía el archivo del certificado antes de leerlo pero si declaro en el uses Vcl.Forms para que reconozca el objeto Application no me compila.
Responder Con Cita