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

Colaboración Paypal con ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #21  
Antiguo 03-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
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.
Responder Con Cita
  #22  
Antiguo 03-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
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.
Responder Con Cita
  #23  
Antiguo 03-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
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;
Imágenes Adjuntas
Tipo de Archivo: jpg imagen_certificado.jpg (22,1 KB, 1 visitas)
Tipo de Archivo: jpg imagen_error.jpg (22,0 KB, 1 visitas)
Responder Con Cita
  #24  
Antiguo 03-10-2023
Garada Garada is offline
Miembro
 
Registrado: jul 2004
Posts: 68
Poder: 21
Garada Va por buen camino
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.
Responder Con Cita
  #25  
Antiguo 04-10-2023
Garada Garada is offline
Miembro
 
Registrado: jul 2004
Posts: 68
Poder: 21
Garada Va por buen camino
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;
Responder Con Cita
  #26  
Antiguo 04-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
Me pongo con ello, muchas gracias.

Si se soluciona así sería genial. Es algo que me quitaba el sueño.
Responder Con Cita
  #27  
Antiguo 04-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
De momento está todo bien menos que el compilador no me reconoce SZ_CERT_STORE_PROV_MEMORY

Voy a investigar
Responder Con Cita
  #28  
Antiguo 04-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
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

Última edición por isnagil fecha: 04-10-2023 a las 10:46:02.
Responder Con Cita
  #29  
Antiguo 04-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
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
Responder Con Cita
  #30  
Antiguo 04-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
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
Responder Con Cita
  #31  
Antiguo 04-10-2023
Garada Garada is offline
Miembro
 
Registrado: jul 2004
Posts: 68
Poder: 21
Garada Va por buen camino
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?
Responder Con Cita
  #32  
Antiguo 04-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
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);
Responder Con Cita
  #33  
Antiguo 04-10-2023
Garada Garada is offline
Miembro
 
Registrado: jul 2004
Posts: 68
Poder: 21
Garada Va por buen camino
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?
Responder Con Cita
  #34  
Antiguo 04-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
Smile

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
Responder Con Cita
  #35  
Antiguo 04-10-2023
Garada Garada is offline
Miembro
 
Registrado: jul 2004
Posts: 68
Poder: 21
Garada Va por buen camino
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.
Responder Con Cita
  #36  
Antiguo 24-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
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.
Responder Con Cita
  #37  
Antiguo 25-10-2023
Garada Garada is offline
Miembro
 
Registrado: jul 2004
Posts: 68
Poder: 21
Garada Va por buen camino
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.
Responder Con Cita
  #38  
Antiguo 25-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
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
Responder Con Cita
  #39  
Antiguo 25-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
¿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;
Responder Con Cita
  #40  
Antiguo 25-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Poder: 0
isnagil Va por buen camino
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.

Última edición por isnagil fecha: 25-10-2023 a las 12:10:18.
Responder Con Cita
Respuesta



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
acceder a Webservice con certificado de cliente iMia Internet 8 13-09-2022 12:20:58
Conectar Webservice con httpRio+Certificado gasal Internet 2 20-07-2018 18:11:08
Como leer un TRemotable que proviene de un webservice apicito Internet 17 02-09-2011 23:48:41
SOAP POST - Webservice con Certificado y SSL JXJ Varios 5 09-05-2011 21:11:08


La franja horaria es GMT +2. Ahora son las 00:48:57.


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