Leer certificado pfx para webservice
 

Hola buenas tardes:

Mi problema es el siguiente:

Quiero cargar un certificado pfx sin tenerlo instalado en windows para utilizarlo en un componente HTTPRio y acceder a un webservice.
Estoy usando RAD STUDIO 10.4

He estado buscando en el foro y ya hay un tema al respecto:

https://www.clubdelphi.com/foros/showthread.php?t=95356

La cuestión es que no puedo usar CAPICOM. En este tema se ofrece una solución utilizando la unidad JwaWinCrypt.

He buscado información y creo que esta unidad está en el componente JWAPI pero no sé como obtenerlo ni como instalarlo.

¿Alguien me puede ayudar, por favor?

Gracias

Buenas.

En el ejemplo que puse en el otro hilo comentaba que la mayoría de las funciones estaban declaradas en la unidad CertHelper de Delphi 2010, prueba a ver si existe la unidad en 10.4 y dime que funciones te faltan y te paso las declaraciones.

Lo revisé un poco y aquí te dejo una versión probada en Delphi 2010 usando sólo la unidad CertHelper que ya viene de serie.

Código Delphi [-]
uses
  CertHelper, WinInet;

function PFXImportCertStore(var pPFX: CRYPT_BIT_BLOB;
                          szPassword: LPCWSTR;
                          dwFlags: DWORD): HCERTSTORE; stdcall; external 'Crypt32.dll';

procedure TformMain.HTTPRIO1HTTPWebNode1BeforePost(
  const HTTPReqResp: THTTPReqResp; Data: Pointer);

  procedure CheckError(Puntero: Pointer);
  begin
    if not Assigned(Puntero) then
      RaiseLastOSError;
  end;


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

  Pass = 'LaContraseña';
var
  pStore: HCERTSTORE;
  pCert: PCERT_CONTEXT;
  DataBlob: CRYPT_BIT_BLOB;
  PFX: TBytes;
begin
  pStore := nil;
  pCert := nil;

  PFX := TFile.ReadAllBytes('ArchivoDelCertificado.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
    InternetSetOption(Data, INTERNET_OPTION_CLIENT_CERT_CONTEXT, pCert, SizeOf(CERT_CONTEXT));
  finally
    if Assigned(pCert) then
      CertFreeCertificateContext(pCert);

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

Muchas gracias Garada, muy amable.

He probado el código y el compilador no reconoce la función InternetSetOption. Seguramente está en otra unidad y me falta añadirla al uses.

InternetSetOption(Data, INTERNET_OPTION_CLIENT_CERT_CONTEXT, pCert, SizeOf(CERT_CONTEXT));

Tampoco reconoce la variable Data que no sé de donde la sacas porque no está declarada.

Si puedes aclararme esto te estaría muy agradecido.

Bueno ya sé de donde vienen la función InternetSetOption. De la unidad WinINet.

Ahora, de momento, solo me falta saber el valor de la variable data para que el procedimiento se pueda compilar.

data es un parámetro del evento BeforePost del WebNode del HTTPRIO.

Al menos en D2010 viene declarado así:

Código Delphi [-]
procedure TformMain.HTTPRIO1HTTPWebNode1BeforePost(const HTTPReqResp: THTTPReqResp; Data: Pointer);

Si en D10.4 es diferente pásame la declaración a ver que ha cambiado.

Ahora es:

HTTPRIO1HTTPWebNode1BeforePost(const HTTPReqResp: THTTPReqResp; Client: THTTPClient);

Pues por lo que veo (he instalado la versión Community Edition) en la versión 10.4 han hecho ese cambio.

Por ahora te puedo decir que todas las funciones del API para gestionar los certificados que estaban en CertHelper y las que te declaré en el ejemplo las vas a encontrar en System.Net.HttpClient.Win

No he podido averiguar que hacer con el THTTPClient que si tiene para elegir el certificado de la lista de los instalados en el sistema pero ni idea como pasarle un certificado de un fichero.
En un foro en inglés hablan de modificar un evento (DoClientCertificateAccepted) para que haga lo que te interesa.

Si averiguo algo más actualizo información. A mi en parte me interesa por si algún día me obligan a actualizar versión de Delphi.

Ok, gracias.

Lo ideal sería cargar directamente el certificado del fichero pfx pero una solución menor sería seleccionar directamente el certificado instalado en almacén de windows sin que aparezca la ventana que le pregunta al cliente.

Voy a buscar información al respecto, aunque por lo que dices sabes como hacerlo.

Gracias por tu interés

He conseguido hacerlo, pero no muy elegantemente.

Delphi no da ninguna oportunidad para cargar un certificado, sólo elegir de la lista de instalados en el equipo.
La clase que se ocupa de todo no es pública y no se puede acceder a ella.

En un foro en inglés alguien comentó que parcheaba modificando las VMT (Virtual Method Table) para que llamara a su función. Pero eso se escapa de mis posibilidades.

El método bruto es copiar la unidad System.Net.HttpClient.Win en la carpeta de tu proyecto y Delphi la usará en vez de la suya.
El archivo está en "C:\Program Files (x86)\Embarcadero\Studio\22.0\source\rtl\net\System.Net.HttpClient.Win.pas"

En tu proyecto, en el evento HTTPRIO1HTTPWebNode1NeedClientCertificate pones el parametro AnIndex a cero. Con eso le indicas que quieres usar el primer certificado ya que si lo dejas como viene (-1) indicas que no elijes ninguno y no saltará la función que modificamos para cargar el certificado.

Código Delphi [-]
procedure TformMain.HTTPRIO1HTTPWebNode1NeedClientCertificate(
  const Sender: TObject; const ARequest: TURLRequest;
  const ACertificateList: TCertificateList; var AnIndex: Integer);
begin
  AnIndex := 0;
end;

Y en la unidad que copiaste, System.Net.HttpClient.Win buscas la función TWinHTTPClient.DoClientCertificateAccepted y le pones el código que se usaba con el D2010

Código Delphi [-]
function TWinHTTPClient.DoClientCertificateAccepted(const ARequest: THTTPRequest; const AnIndex: Integer): Boolean;

  procedure CheckError(Puntero: Pointer);
  begin
    if not Assigned(Puntero) then
      RaiseLastOSError;
  end;

const
  CERT_COMPARE_HAS_PRIVATE_KEY        = 21;
  CERT_FIND_HAS_PRIVATE_KEY           = CERT_COMPARE_HAS_PRIVATE_KEY shl CERT_COMPARE_SHIFT;

  Pass = 'LaContraseña';
var
  pStore: HCERTSTORE;
  pCert: PCERT_CONTEXT;
  DataBlob: CRYPT_DATA_BLOB;
  PFX: TBytes;

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

  PFX := TFile.ReadAllBytes('certificado.pfx');

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

    // Almacen temporal con el contenido del PFX
    pStore := PFXImportCertStore(@DataBlob, PWideChar(Pass), 0);
    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;

Hola Garada, buenos días.

Muchas gracias por tu ayuda. Es maravillosa.

Una duda. Has hecho cambios cambios en el código respecto a la primera versión:

DataBlob: CRYPT_BIT_BLOB; por DataBlob: CRYPT_DATA_BLOB;
PKCS12_INCLUDE_EXTENDED_PROPERTIES = $0010 por 0

Es que entonces habría que cambiar la función:

¿Cuál es la versión correcta?

De todas formas si pongo


y cambio el tipo del datablob por un CRYPT_BIT_BLOB me sigue dando un error de "types of actual and formal var parameters must be identical"

Hola,

He cambiado el sitio donde declaro la función PFXImportCertStore. Lo he cambiado aquí:

Y ahora no me da error, cambiando el tipo de datablob.

Lo que pasa es que me da otros errores:

No me reconoce ni Enter ni Exit del tipo Monitor:

ni

Undeclared identifier

En dicha unidad: System.Net.HttpClient.Win;

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.

No hay que darlas.

Los cambios viene a que en esa unidad (System.Net.HttpClient.Win) ya viene declarado todo lo que necesitas y que antes estaba en Certhelper o declaradas a mano.

PKCS12_INCLUDE_EXTENDED_PROPERTIES es opcional, sólo informa que se quiere importar el certificado con las propiedades extendidas. Este flag sí que no estaba declarado en la unidad y como no afecta al funcionamiento, lo descarté.

El resto pues lo comentado, ya está en la unidad sin necesidad de añadir nada al USES. De hecho me extraña que no te diera error por declarar dos veces la función PFXImportCertStore

Si tienes que añadir alguna unidad al USES, añádela al principio de la lista para que no afecte a los originales (tendrán preferencia sobre las tuyos)

Entonces es que supongo que no tenemos el mismo código en la unidad System.Net.HttpClient.Win

En el que tengo yo en el que no aparece por ningún lado la función PFXImportCertStore, como te decía la he tenido que declarar yo y si declaro la unidad Vcl.Forms

Código Delphi [-]
function ShowSelectCertificateDialog(AParentWnd: UIntPtr;
  const ATitle, ADisplayString: string; var ACertificate): Boolean;

implementation

uses
  System.SysUtils,
  System.Classes,
  System.Generics.Collections,
  System.SyncObjs,
  System.Net.URLClient,
  System.NetConsts,
  System.Net.HttpClient,
  System.Types,
  Winapi.Windows,
  Winapi.WinHTTP,
  System.NetEncoding,
  System.Net.Mime,
  //Vcl.Forms,
  Vcl.Dialogs,
  System.IOUtils;

me salen errores:

Código Delphi [-]
TMonitor.Enter(ARequest);

Undeclared identifier: 'Enter'

Ok, yo lo he probado en Delphi 11 ya que la 10.4 ya me había caducado.

Es correcto entonces añadir la función a mano.

Para el error, cambia Tmonitor por System.Tmonitor

ok, muchas gracias.

Con el system me funciona bien.

Ahora me piden otra cosa al respecto que me he jodido todo el invento.

Poder seleccionar un certificado según un parámetro que se le pasaría al componente HTTPRIO. Si condición elegimos el certificado 1 sino el 2

El problema es que al estar el procedimiento en la unidad System.Net.HttpClient.Win y no en el componente HTTPRIO no puedo pasarle ningún parámetro. He pensado en pasar el procedimiento al evento OnNeedClientCertificate pero los parámetros no son los mismos:

Código Delphi [-]
NeedClientCertificate(
  const Sender: TObject; const ARequest: TURLRequest;
  const ACertificateList: TCertificateList; var AnIndex: Integer);

Código Delphi [-]
DoClientCertificateAccepted(const ARequest: THTTPRequest; const AnIndex: Integer): Boolean;

El problema estaría aquí:

Código Delphi [-]
LRequest := TWinHTTPRequest(ARequest);
Result := WinHttpSetOption(LRequest.FWRequest, WINHTTP_OPTION_CLIENT_CERT_CONTEXT, pCert, SizeOf(CERT_CONTEXT));

Si añades al USES la unidad con el HTTPRIO puedes acceder a él.

Si quieres separarlo, podrías usar el parámetro AnIndex que es numérico y ya lees el certificado que te interese según su valor.

El problema es que he creado una clase heredada de THTTPRIO

TMi_HTTPRIO = class(THTTPRIO)

Y como envío y recibo varios tipos de XML, voy creando distintos HTTPRIOs para cada tipo de XML que se envía, con lo cual no puedo acceder a él desde System.Net.HttpClient.Win, principalmente porque no sé ni cuál es.

Otra cosa, he comentado el procedimiento DoClientCertificateAccepted que he modificado en la unidad System.Net.HttpClient.Win y la aplicación elige el primer certificado que encuentra en el almacén y lo utiliza sin preguntar. O sea que realmente no sé si realiza alguna función. ¿Si desinstalo los certificados que tengo instalados cogerá el certificado que le indico del fichero pfx?

De todas formas sin poder seleccionarlo desde esta unidad no me sirve para mucho.

Por otra parte si utilizo el evento httWebNodeNeedClientCertificate cómo sé qué certificado tengo en según el parámetro AnIndex. Es decir si tengo varios instalados como sé cuál es cuál.

Sin ver todo en su conjunto, algunas ideas.

1 - Hacer publica la clase TWinHTTPClient para que puedas acceder a ella desde los eventos del httprio y asignarle p.e. una propiedad con el fichero o el stream del certificado.
2 - Pasar el HTTPRio como Integer a través del parametro AnIndex para acceder a él desde el TWinHttpClient

Yo haría la 1

Y aparte, sobre el AnIndex. En la unidad sin modificar, te pasa la lista de certificados y devuelves el índice del que quieres usar o -1 si no eliges.
En la versión modificada que te pase, le da igual cual elijas (excepto -1) pq va a cargar el certificado del fichero siempre.
En la modificación puedes usar 1 o 2 para que después tu elijas tu certificado 1 o 2. (esa es una tercera opción)

Ayer desinstalé todos los certificados que tenía instalados y lancé una prueba.

Me devuelve un error:

class ESOAPHTTPException with message Received content of invalid Content-type setting: text/html - SOAP expects text/xml

Lo extraño es que es antes de pasar por el evento WebNodeNeedClientCertificate

Si instalo el certificado lo envía sin problemas. Tengo serias dudas de que esté cargando el certificado del fichero.

Si comento la linea

Código Delphi [-]
// AnIndex := 0;

En el evento OnNeedClientCertificate me sale exactamente el mismo error, con lo cual deduzco que tengo que tener instalado el certificado. Por eso creo que no está cargando el certificado del fichero.

Rectifico respecto a lo de antes. Sí que carga el certificado del fichero pero es necesario tener instalado un certificado en el almacén, con lo cual en realidad la carga del fichero es innecesaria.

Yo quería ahorrarme la instalación del certificado y cargarlo directamente del fichero.

Lo que quiero decir es que si el almacén de certificados está vacío da un error.

Código Delphi [-]
const ACertificateList: TCertificateList; var AnIndex: Integer);
begin
  AnIndex := -1;
end;

Entiendo. Es lógico, el parche está después de seleccionar el certificado.
Si en el sistema no hay ninguno pues ni siquiera pregunta cual quieres usar.

La solución es cambiarlo todo al lugar donde se crea la lista de certificados y se cambia la lista del sistema por la tuya.

En el System.Net.HttpClient.Win del delphi 10.4 está declarada la siguiente función?

Código Delphi [-]
class function TWinHttpLib.GetCertStore: HCERTSTORE;

Si es así, la sustituyes por esto:

Código Delphi [-]
class function TWinHttpLib.GetCertStore: HCERTSTORE;
const
  Pass = 'LaContraseña';
var
  DataBlob: CRYPT_DATA_BLOB;
  PFX: TBytes;
begin
  FLock.Enter;
  try
    if FStore = nil then
    begin
      PFX := TFile.ReadAllBytes('certificado.pfx');

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

      // Almacen temporal con el contenido del PFX
      FStore := PFXImportCertStore(@DataBlob, PWideChar(Pass), 0);
    end;

    Result := FStore;
  finally
    FLock.Leave;
  end;
end;

Y por supuesto descartas todo lo que se hizo anteriormente en function TWinHTTPClient.DoClientCertificateAccepted

Ya sólo en el evento HTTPRIO1HTTPWebNode1NeedClientCertificate de la unidad del HTTPRIO usas AnIndex para elegir el certificado que te interese de los que leíste

La función que te paso está incompleta pq sólo lee un certificado, tengo que mirar como añadir varios PFX a la misma Store y te amplio. Pero por ahora puedes ir probando.

Y esta es la modificación para leer varios PFX y pasarlos al THttpClient
Si hay alguna función que no tengas declarada avisa.

Código Delphi [-]
function CertAddCertificateContextToStore(hCertStore: HCERTSTORE;
                                          pCertContext: PCCERT_CONTEXT;
                                          dwAddDisposition: DWORD;
                                          ppStoreContext: PCCERT_CONTEXT): BOOL; stdcall; external 'Crypt32.dll';

class function TWinHttpLib.GetCertStore: HCERTSTORE;

  procedure AddPFX(f: string);
  const
    CERT_STORE_ADD_USE_EXISTING = 2;
    Pass = 'LaContraseña';
  var
    pTmpStore: HCERTSTORE;
    pCert: PCERT_CONTEXT;
    DataBlob: CRYPT_DATA_BLOB;
    PFX: TBytes;
  begin
    PFX := TFile.ReadAllBytes(f);

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

    // se lee el pfx en un almacen en memoria
    pTmpStore := PFXImportCertStore(@DataBlob, PWideChar(Pass), 0);

    // se copian los certificados al almacen que usa el HttpClient
    pCert := CertEnumCertificatesInStore(pTmpStore, nil);
    while pCert <> nil do
    begin
      if not CertAddCertificateContextToStore(FStore, pCert, CERT_STORE_ADD_USE_EXISTING, nil) then
        RaiseLastOSError;

      pCert := CertEnumCertificatesInStore(pTmpStore, pCert);
    end;

    CertCloseStore(pTmpStore, 0);
  end;

begin
  FLock.Enter;
  try
    if FStore = nil then
    begin
      // almacen temporal en memoria para el HttpClient
      FStore := CertOpenStore(sz_CERT_STORE_PROV_MEMORY, 0, 0, 0, nil);

      AddPFX('certificado1.pfx');
      AddPFX('certificado2.pfx');
    end;

    Result := FStore;
  finally
    FLock.Leave;
  end;
end;

Me pongo con ello, muchas gracias.

Si se soluciona así sería genial. Es algo que me quitaba el sueño.

De momento está todo bien menos que el compilador no me reconoce SZ_CERT_STORE_PROV_MEMORY

Voy a investigar

He sustituido SZ_CERT_STORE_PROV_MEMORY por 'Memory' y ya puedo compilarlo.

El problema es que me da una excepción cuando ejecuta la función

FStore := CertOpenStore('Memory', 0, 0, 0, nil);

No creo que poner 'Memory' sea lo correcto pero no tengo más información

Se puede ver en la imagen

He sustituido SZ_CERT_STORE_PROV_MEMORY por 'Memory' y ya puedo compilarlo.

El problema es que me da una excepción cuando ejecuta la función

FStore := CertOpenStore('Memory', 0, 0, 0, nil);

No creo que poner 'Memory' sea lo correcto pero no tengo más información

He sustituido SZ_CERT_STORE_PROV_MEMORY por 'Memory' y ya puedo compilarlo.

El problema es que me da una excepción antes de cargar los certificados. No los llega a cargar.

Es en el FWebNode.Execute(Req, Resp);

Se puede ver en la imagen

Sí, la declaración es

Código Delphi [-]
sz_CERT_STORE_PROV_MEMORY           = 'Memory';

Y es un PAnsiChar.

En la última modificación eliminé el control de errores por simplificar el código pero puedes añadir de nuevo la función CheckError y comprobar los punteros devueltos por las funciones del CryptoAPI

De todas formas yo probé con la constante de cadena como tú y no me falla.

¿Cómo está declarada y dónde en tu código la función CertOpenStore?

La función CertOpenStore está declarada así:

Código Delphi [-]
function CertOpenStore(lpszStoreProvider: LPCSTR; dwEncodingType: DWORD;
  hCryptProv: HCRYPTPROV; dwFlags: DWORD; pvPara: Pointer): HCERTSTORE; stdcall; external Crypt32 name 'CertOpenStoreW' delayed;
{$EXTERNALSYM CertOpenStore}

En la unidad System.Net.HttpClient.Win

Al final modificado GetCertStore queda así:

Código Delphi [-]
class function TWinHttpLib.GetCertStore: HCERTSTORE;
procedure AddPFX(path, pass: string);
  const
    CERT_STORE_ADD_USE_EXISTING = 2;
    //Pass = 'LaContraseña';
  var
    pTmpStore: HCERTSTORE;
    pCert: PCERT_CONTEXT;
    DataBlob: CRYPT_BIT_BLOB;
    PFX: TBytes;
  begin
    PFX := TFile.ReadAllBytes(path);

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

    // se lee el pfx en un almacen en memoria
    pTmpStore := PFXImportCertStore(DataBlob, PWideChar(Pass), 0);

    // se copian los certificados al almacen que usa el HttpClient
    pCert := CertEnumCertificatesInStore(pTmpStore, nil);
    while pCert <> nil do
    begin
      if not CertAddCertificateContextToStore(FStore, pCert, CERT_STORE_ADD_USE_EXISTING, nil) then
        RaiseLastOSError;

      pCert := CertEnumCertificatesInStore(pTmpStore, pCert);
    end;

    CertCloseStore(pTmpStore, 0);
  end;

begin
  FLock.Enter;
  try
    if FStore = nil then
    begin
      // almacen temporal en memoria para el HttpClient
      // FStore := CertOpenStore(SZ_CERT_STORE_PROV_MEMORY, 0, 0, 0, nil);
      FStore := CertOpenStore('Memory', 0, 0, 0, nil);

      AddPFX('XXXXXX.pfx', 'XXXXXXX');
      AddPFX('XXXXXX.pfx', 'XXXXX');
    end;

    Result := FStore;
  finally
    FLock.Leave;
  end;
end;

He cambiado DataBlob: CRYPT_DATA_BLOB; por DataBlob: CRYPT_BIT_BLOB; como la otra vez

Y el error lo da en la instrucción FStore := CertOpenStore('Memory', 0, 0, 0, nil);

En Delphi 11 está declarada así:

Código Delphi [-]
function CertOpenStore(lpszStoreProvider: LPCSTR; dwEncodingType: DWORD;
  hCryptProv: HCRYPTPROV; dwFlags: DWORD; pvPara: Pointer): HCERTSTORE; stdcall; external Crypt32 name 'CertOpenStore' delayed;
{$EXTERNALSYM CertOpenStore}

La diferencia está después de name
Cosa rara pq esa función no tiene versión ANSI y WideString com otras que yo haya visto.

Cambia la declaración y ponla como la del Delphi 11.

¿Por cierto cuál es el error?

A mi también me resultaba extraña la W y he pensado en quitarla, pero no me he atrevido. :)

Por lo que he probado creo que funciona perfectamente.

No me lo acabo de creer, después de tanta guerra.

Muchas gracias

No hay que darlas y me alegro que haya salido todo OK al fin.

Ya tengo medio trabajo hecho para cuando tenga que actualizar el Delphi. 👍

Lo grave es que a estas alturas no hayan preparado una forma fácil de pasar un certificado a un HTTPRIO... por lo menos te deja elegir del sistema.

Haciendo pruebas masivas he detectado problemas, hasta la fecha no se había necesitado cambiar de certificado.

El procedimiento que cambiamos en la unidad System.Net.HttpClient.Win, carga un certificado seguro, pero no sé si carga el segundo

Código Delphi [-]
class function TWinHttpLib.GetCertStore: HCERTSTORE; 
  procedure  AddPFX(path, pass: string); 
  const 
    CERT_STORE_ADD_USE_EXISTING = 2; 
    //Pass = 'LaContraseña'; 
  var 
  pTmpStore: HCERTSTORE; 
  pCert: PCERT_CONTEXT; 
  DataBlob: CRYPT_BIT_BLOB; 
  PFX: TBytes; 
  begin 
    //showmessage ('Cargando certificado ' + path); 
    PFX :=  TFile.ReadAllBytes(path); 
    DataBlob.cbData := Length(PFX); 
    DataBlob.pbData := @PFX[0]; 
    // se lee el pfx en un almacen en  memoria 
    pTmpStore := PFXImportCertStore(DataBlob, PWideChar(Pass),  0); 
    // se copian los certificados al almacen que usa el HttpClient 
    pCert := CertEnumCertificatesInStore(pTmpStore, nil); 
    
    while  pCert <> nil do 
    begin 
       if not  CertAddCertificateContextToStore(FStore, pCert,  CERT_STORE_ADD_USE_EXISTING, nil) then 
         RaiseLastOSError; 
       pCert := CertEnumCertificatesInStore(pTmpStore, pCert); 
    end; 


    CertCloseStore(pTmpStore, 0); 
  end; 
begin 
  try 
    FLock.Enter;  

      try 
        if FStore = nil then 
        begin 
           // almacen temporal  en memoria para el HttpClient 
           FStore := CertOpenStore('Memory',  0, 0, 0, nil); 
           AddPFX('XXXXXXX.pfx', 'XXXXXX'); 
           AddPFX('YYYYYYY.pfx', 'YYYYYY'); 
        end; 
    Result := FStore; 
  finally 
     FLock.Leave; 
  end;

Yo cambio los certificados cargados en el evento:

Código Delphi [-]
procedure TMi_HTTPRIO.httWebNodeNeedClientCertificate(const Sender:  TObject; const ARequest: TURLRequest;  const ACertificateList:  TCertificateList; var AnIndex: Integer); 
begin 
  AnIndex :=  certificado; 
end;

Certificado es una propiedad del componente HTTPRio al que le asigno un valor cuando quiero cambiar de certificado en cada envío. Pero por este evento solo pasa una vez. Con lo cual siempre envía con el primer certificado que se carga. Por ahí he leído que cada vez que se cambia de certificado hay que cerrar la conexión pero no sé dónde se hace esto.

O a lo mejor hay que seleccionar el certificado en otro evento.

Por otra parte no tengo manera exacta de saber que certificado estoy usando en cada momento. Si en el evento

Código Delphi [-]
HTTPRIO.httBeforeExecute(const MethodName: string; SOAPRequest: TStream);

Simplemente pongo un showmessage del nombre del certificado:

Código Delphi [-]
Showmessage (Self.HTTPWebNode.ClientCertificate.CertName);

Me sale un mensaje en blanco.


En fin, no sé como resolver estos dos problemas.

En parte puede ser normal. En el mismo navegador si seleccionas un certificado, se queda seleccionado hasta que lo cierras y abres de nuevo.

Yo normalmente no reutilizo los HTTPRio, los creo y libero en cada consulta o consultas encadenadas.

Pero mañana le echo un vistazo que como comentas puede haber una forma de reiniciar la sesión de inet.

El problema es que es un proceso en el que se realizan muchos envíos al día y la velocidad del proceso es primordial. En un envío no es significativo pero con esa cantidad, y añadiendo el tiempo de creación del XML, etc. el tiempo aumenta bastante si creo el componente, cargo los certificados, envío y libero y vuelvo a repetir el proceso.


De todas formas voy a implementar el proceso creando y liberando el componente en cada envío a ver como queda.


Saludos y gracias

¿Cómo liberas el componente HTTPRio?


Porque si hago un free del componente me salta un error



Invalid pointer


en el evento

Código Delphi [-]
procedure TRIO.BeforeDestruction;
begin
  inherited;
  if FRefCount <> 0 then
    raise Exception.Create(SInvalidPointer);
end;

Comprobado, esto no funciona:

Código Delphi [-]
procedure TMi_HTTPRIO.httWebNodeNeedClientCertificate(const Sender:  TObject; const ARequest: TURLRequest;  const ACertificateList:  TCertificateList; var AnIndex: Integer);  
begin    
  AnIndex := lo que sea;    
end;

Pongas el número que pongas siempre selecciona el primero.

Rectifico, sí que funciona, el problema es que cada vez que los cargo me los ordena al azar.
Bueno el problema es como cambiarlo después del primer envío.