Ver Mensaje Individual
  #406  
Antiguo 21-03-2017
PepCat PepCat is offline
Miembro
 
Registrado: mar 2017
Posts: 96
Reputación: 8
PepCat Va por buen camino
Cita:
Empezado por seccion_31 Ver Mensaje
keys ...
Código:
procedure TfEmitidas.emitidasHTTPWebNode1BeforePost(
  const HTTPReqResp: THTTPReqResp; Data: Pointer);
var
     Store : IStore;
     Certs : ICertificates;
     Cert : ICertificate2;
     CertContext : ICertContext;
     PCertContext : PCCERT_CONTEXT;
     V : OleVariant;
 const
     INTERNET_OPTION_CLIENT_CERT_CONTEXT = 84;
 begin

     V:='  ***  EL NOMBRE DE TU CERTIFICADO ***';

     Store := CoStore.Create;
     Store.Open(CAPICOM_CURRENT_USER_STORE, 'MY',CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED );
     Certs:=Store.Certificates.Find(CAPICOM_CERTIFICATE_FIND_SUBJECT_NAME,V,False ); { Buscar certificado por nombre }
     if Certs.Count > 0 then
     begin
         Cert:=IInterface(Certs.Item[1]) as ICertificate2;
         CertContext:=Cert as ICertContext;
         CertContext.Get_CertContext(Integer(PCertContext));
         if InternetSetOption(Data,INTERNET_OPTION_CLIENT_CERT_CONTEXT,PCertContext,Sizeof(CERT_CONTEXT)) = False then
         begin
             ShowMessage( 'Internet SSL certificate. Something went wrong' );
         end;
     end;
 end;

A parte de poder buscar el certificado en el store como en el ejemplo anterior, que funciona perfectamente (muchas gracias por el post!)
también he visto que hay la opción de poder leer el certificado desde un fichero:


Código Delphi [-]

procedure SetCertificate(const FileName, Password: string; var Data: Pointer);
var
  Cert : ICertificate2;
  CertContext : ICertContext;
  PCertContext : PCCERT_CONTEXT;
begin
  try
    Cert := CoCertificate.Create;
  except
    on E: EOleSysError  do
      raise Exception.Create('CAPICOM.DLL is not registered')
  end;

  Cert.Load(FileName, Password, CAPICOM_KEY_STORAGE_EXPORTABLE, CAPICOM_LOCAL_MACHINE_KEY);
  CertContext := Cert as ICertContext;
  CertContext.Get_CertContext(Integer(PCertContext));
  if InternetSetOption(Data, INTERNET_OPTION_CLIENT_CERT_CONTEXT, PCertContext, Sizeof(CERT_CONTEXT)) = False then
    raise Exception.Create ( 'Error setting "' + FileName + '" certificate in web service' )
end;

procedure TfEmitidas.emitidasHTTPWebNode1BeforePost(const HTTPReqResp: THTTPReqResp; Data: Pointer);
begin
  SetCertificate('', '', Data);
end;


P.D. Muchas gracias a todos los que colaboráis en este forum, que me habéis ayudado muchísimo en afrontar este tema.
Responder Con Cita