Add an A3 certificate to the Tidssliohandlersocketopenssl component

Question

I would like to know how I can achieve the integration of a digital certificate of the kind A3 to the component Tidssliohandlersocketopenssl. I already managed to perform the search part and choose which digital certificate to use, but now I’m having difficulty associating the chosen certificate to the component Tidssliohandlersocketopenssl, because I need to make the access to the site GNRE - https://www.testegnre.pe.gov.br/gnreWS/services/GnreLoteReception which requires that the connection to that webservice be made through a certificate.

Function that obtains the certificate settings

This function uses the Microsoft Capicom component.

function TForm1.GetCertificado: Boolean;
var
  Store: IStore3;
  CertsLista, CertsSelecionado: ICertificates2;
  CertDados: ICertificate;
  lSigner: TSigner;
  lSignedData: TSignedData;
begin
  Result := False;
  Store := CoStore.Create;
  Store.Open(CAPICOM_CURRENT_USER_STORE, 'My',CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED);

  CertsLista := Store.Certificates as ICertificates2;
  CertsSelecionado := CertsLista.Select('Certificado(s) Digital(is) disponível(is)',
'Selecione o Certificado Digital para uso no aplicativo', False);

  if not(CertsSelecionado.Count = 0) then
    begin
      CertDados := IInterface(CertsSelecionado.Item[1]) as ICertificate2;
      { Configura o objeto responsável por fazer a assinatura, informando qual é o certificado a ser usado e o conteúdo a ser assinado }
      lSigner := TSigner.Create(self);
      lSigner.Certificate := CertDados;
      lSignedData := TSignedData.Create(self);
      lSignedData.Content := ' ';

      if CertDados.ValidFromDate > Now then
        begin
          showmessage('Certificado não liberado. aguardar ' + datetostr(CertDados.ValidFromDate));
          exit;
        end;

      if CertDados.ValidToDate < Now then
        begin
          showmessage('Certificado expirado');
          exit;
        end;

      { Solicita a senha }
      lSignedData.Sign(lSigner.DefaultInterface, False, CAPICOM_ENCODE_BASE64);

      Result := True;

      lSignedData.Free;
      lSigner.Free;
    end;
end;

Access to the Webservice

function EnvioWS(XML:String):String;
var
  SSLIOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
  IdHTTP: TIdHTTP;
  Retorno, Envio: TStringStream;
begin
  try //Instancia e configuração
    IdHTTP := TIdHTTP.Create(nil);
    IdHTTP.HTTPOptions := [hoKeepOrigProtocol];
    SSLIOHandlerSocketOpenSSL := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP);
    IdHTTP.IOHandler := SSLIOHandlerSocketOpenSSL;
    IdHTTP.Request.CharSet := 'UTF-8';
    IdHTTP.Request.ContentType := 'application/soap+xml; charset=utf-8';


    if GetCertificado then
    begin        
      //Envio ao WS
      Envio := TStringStream.Create(XML);
      Retorno := TStringStream.Create(EmptyStr);
      IdHTTP.CustomHeaders.Add(Format('SOAPAction: "%s"', ['http://www.gnre.pe.gov.br/webservice/GnreResultadoLote/GnreConfigUF']));
      IdHTTP.post(Envio, Retorno);
      Result := Retorno.DataString;
    end;
  finally
    if assigned(IdHTTP) then
      FreeAndNil(IdHTTP);
    if assigned(Retorno) then
      FreeAndNil(Retorno);
    if assigned(Envio) then
      FreeAndNil(Envio);
  end;
end;

Answer 1

try:

function THTTPReqRespCertificado.EnviarSoapRequest(const strUrl,
   strXmlSoapRequest: string): string;
var
   requester: THTTPReqResp;
   strStrem: TStringStream;
begin
   strStrem := nil;
   try
      requester := THTTPReqResp.Create(nil);
      requester.OnBeforePost := OnBeforePostCertificado;
      requester.URL := strUrl;
      requester.UseUTF8InHeader := True;
      strStrem := TStringStream.Create;
      requester.Execute(strXmlSoapRequest, strStrem);
      Result := strStrem.DataString;
   finally
      if Assigned(requester) then
         FreeAndNil(requester);
      if Assigned(strStrem) then
         FreeAndNil(strStrem);
   end;
end;


procedure THTTPReqRespCertificado.OnBeforePostCertificado(
   const HTTPReqResp: THTTPReqResp; Data: Pointer);
var
   certificado: ICertificate2;
   CertContext: ICertContext;
   PCertContext: PCCERT_CONTEXT;
   ContentHeader: string;
const
   ContentTypeTemplate: string = 'Content-Type: %s';
begin
   certificado := TCertificateFactory.GetCertificate(strSerialCertificado);
   if Assigned(certificado) then
   begin
      if Supports(certificado, ICertContext, CertContext) then
      begin
         CertContext.Get_CertContext(Integer(PCertContext));

         if not InternetSetOption(Data, INTERNET_OPTION_CLIENT_CERT_CONTEXT, PCertContext, Sizeof(CERT_CONTEXT) * 5) then
            raise Exception.Create('OnBeforePostCertificado: Error Message');

         ContentHeader := Format(ContentTypeTemplate, ['application/soap+xml; charset=utf-8']);
         HttpAddRequestHeaders(Data, PChar(ContentHeader), length(ContentHeader), HTTP_ADDREQ_FLAG_REPLACE);
         HTTPReqResp.CheckContentType;
      end;
   end;
end;

Tcertificatefactory.Getcertificate(strSerialCertified); is a method that returns the certificate by serial, Voce can replace it by its method of obtaining the certificate

class function TCertificateFactory.GetCertificate(
   const strSerial: string): ICertificate2;
var
   store: IStore3;
   intContCertificado: Integer;
   sig: ISigner;
   sigData: ISignedData;
   retorno: ICertificate2;
begin
   Result := nil;
   retorno := nil;
   try
      CoInitialize(nil);
      store := CoStore.Create;
      store.Open(CAPICOM_CURRENT_USER_STORE, 'My', CAPICOM_STORE_OPEN_READ_ONLY);

      for intContCertificado := 1 to store.Certificates.Count do
      begin
         if (Supports(store.Certificates[intContCertificado], ICertificate2, retorno))
            and (retorno.SerialNumber = strSerial) then
         begin
            sig := CoSigner.Create;
            sig.Certificate := retorno;

            sigData := CoSignedData.Create;
            sigData.Content := ' ';

            sigData.Sign(sig, False, CAPICOM_ENCODE_BASE64);
            Result := retorno;
            Exit;
         end;
      end;
   finally
      if Assigned(store) then
      begin
         store.Close;
         store := nil;
      end;
      CoUninitialize;
   end;

end;