Leer certificado pfx para webservice

[isnagil]

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.

[isnagil]

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;

[Garada]

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.

[Garada]

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;

[isnagil]

Me pongo con ello, muchas gracias.

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

[isnagil]

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

Voy a investigar

[isnagil]

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

[isnagil]

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

[isnagil]

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