TICKET BAI (TicketBAI); Nuevo sistema de la Agencia Tributaria del Pais Vasco

juramisa · #1 04-11-2020

Buenas tardes
Ya se ha puesto en marcha el entorno de pruebas LROE en Bizkaia, estoy probando, y en:

Código Delphi [-]unit System.Net.HttpClient.Win;

procedure TWinHTTPClient.DoGetClientCertificates(const ARequest: THTTPRequest;
  const ACertificateList: TList);

la aplicación casca, da el terrorífico 'Access violation .....'. Uso uso Delphi 10 Seattle y los componentes TNetHTTPClient y TNetHTTPRequest.
La selección del certificado la realizo en el evento OnNeedClientCertificate,

Código Delphi [-]procedure Tfrm140CTB.NetHTTPClient1NeedClientCertificate(const Sender: TObject; const ARequest: TURLRequest; const ACertificateList: TCertificateList; var AnIndex: Integer);
var
  i: Integer;
begin
  for i := 0 to ACertificateList.Count - 1 do
  begin

    if  (SameText(ACertificateList[i].Subject, mi_certificado.Caption)) then
    begin
      AnIndex := i;
      break;
    end;
  end;
end;

He puesto una traza al comienzo de este procedimiento, y ni siquiera llega
Si alguien utiliza este sistema, y le funciona, agradecido me eche una mano.

elcharlie · #2 05-11-2020

Cita:

Empezado por juramisa

Buenas tardes
Ya se ha puesto en marcha el entorno de pruebas LROE en Bizkaia, estoy probando, y en:

Código Delphi [-]unit System.Net.HttpClient.Win;

procedure TWinHTTPClient.DoGetClientCertificates(const ARequest: THTTPRequest;
  const ACertificateList: TList);

la aplicación casca, da el terrorífico 'Access violation .....'. Uso uso Delphi 10 Seattle y los componentes TNetHTTPClient y TNetHTTPRequest.
La selección del certificado la realizo en el evento OnNeedClientCertificate,

Código Delphi [-]procedure Tfrm140CTB.NetHTTPClient1NeedClientCertificate(const Sender: TObject; const ARequest: TURLRequest; const ACertificateList: TCertificateList; var AnIndex: Integer);
var
  i: Integer;
begin
  for i := 0 to ACertificateList.Count - 1 do
  begin

    if  (SameText(ACertificateList[i].Subject, mi_certificado.Caption)) then
    begin
      AnIndex := i;
      break;
    end;
  end;
end;

He puesto una traza al comienzo de este procedimiento, y ni siquiera llega
Si alguien utiliza este sistema, y le funciona, agradecido me eche una mano.

Buenos dias!
yo lo hago mas o menos así, y de momento, ningún problema. No sé cual será tu problema, eso sí, lo estoy haciendo con Delphi 10.3 Rio. Pero yo creo que el problema no está en ese evento, tiene que ser en otra parte

juramisa · #3 05-11-2020

Gracias elcharlie,
El error se da en el siguiente procedimiento de la unit System.Net.HttpClient.Win, marco la instrucción en rojo;

Código Delphi [-]procedure TWinHTTPClient.DoGetClientCertificates(const ARequest: THTTPRequest;
  const ACertificateList: TList);
var
  LRequest: TWinHTTPRequest;
  LStore: HCERTSTORE;
  LIssuerList: PSecPkgContext_IssuerListInfoEx;
  LClientCert: PCCERT_CONTEXT;
  LSearchCriteria: CERT_CHAIN_FIND_BY_ISSUER_PARA;
  LIssuerListSize: DWORD;
  LPrevChainContext, LClientCertChain: PCCERT_CHAIN_CONTEXT;
  LCertificate: TCertificate;
begin
  inherited;

  if FWinCertList.Count = 0 then
  begin
    LRequest := TWinHTTPRequest(ARequest);

    LIssuerList := nil;
    LIssuerListSize := SizeOf(LIssuerList);

    if WinHttpQueryOption(LRequest.FWRequest, WINHTTP_OPTION_CLIENT_CERT_ISSUER_LIST, LIssuerList, LIssuerListSize) = TRUE then
    begin
      FillChar(LSearchCriteria, SizeOf(LSearchCriteria), 0);
      LSearchCriteria.cbSize := SizeOf(LSearchCriteria);
      LSearchCriteria.cIssuer := LIssuerList.cIssuers;
      LSearchCriteria.rgIssuer := LIssuerList.aIssuers;

      LStore := TCertificateStore.Store;
      if LStore <> nil then
      begin
        LPrevChainContext := nil;
        while True do
        begin
          LClientCertChain := CertFindChainInStore(LStore, X509_ASN_ENCODING,
            CERT_CHAIN_FIND_BY_ISSUER_CACHE_ONLY_URL_FLAG or CERT_CHAIN_FIND_BY_ISSUER_CACHE_ONLY_FLAG,
            CERT_CHAIN_FIND_BY_ISSUER, @LSearchCriteria, LPrevChainContext);

          if LClientCertChain <> nil then
          begin
            LPrevChainContext := LClientCertChain;
            LClientCert := LClientCertChain.rgpChain^.rgpElement^.pCertContext;
            CertDuplicateCertificateContext(LClientCert); // Need to be released (CertFreeCertificateContext)
            CryptCertToTCertificate(LClientCert, LCertificate);
            FCertificateList.Add(LCertificate);
            FWinCertList.Add(LClientCert);
          end
          else
            Break;
        end;
      end;
      GlobalFree(HGLOBAL(LIssuerList));
    end;
  end;
  ACertificateList.Clear;
  ACertificateList.AddRange(FCertificateList);
end;

¿Serías tan amable de mandarme ese procedimiento en la versión Rio?. Viéndolo, parece que es un problema al cargar la lista de los certificados presentes en el ordenador.
¿Tal vez hay una orden previa para la carga de los certificados y que yo no la esté realizando?

Gracias.

keys · #4 05-11-2020

Hola a todos.

En el componente TNetHttpClient tienes un evento OnRequestError, intenta capturar el error que te da.

Un Saludo

juramisa · #5 05-11-2020

Hola
keys, da lo siguiente, yo la verdad con esos errores nunca he podido saber nada, y da como he dicho al cargar la lista de certificados. Vosotros cargáis dicha lista antes, o le dices como cargarla antes de ejecutar

Código Delphi [-]NetHTTPClient1.Post(la_url, ss).ContentAsString(tencoding.UTF8);

Código Delphi [-]---------------------------
BATUZ
---------------------------
Access violation at address 00B19045 in module 'BATUZ.exe'. Read of address 00000004
---------------------------
OK   
---------------------------

Gracias

keys · #6 05-11-2020

Prueba primero a poner un certificado sin hacer nada en ese evento.

AnIndex := 0; //o el que tu tengas.

Yo tampoco creo que sea del certificado. ¿No te pasa por el evento OnRequestError que te he comentado ?

juramisa · #7 05-11-2020

Hola

Por el error si pasa

Código Delphi [-]procedure TfrmEnve140CTB.NetHTTPClient1RequestError(const Sender: TObject;
  const AError: string);
begin
  ShowMessage(Aerror);
end;

por el evento

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

no llega, ambos tienen una parada. Da el error comentado anteriormente y termina.
gracias

juramisa · #8 05-11-2020

keys

Aerror = Access violation at address 00B19045 in module 'BATUZ.exe'. Read of address 00000004

keys · #9 05-11-2020

Yo creo que el problema es de delphi seattle.

Si el error da en ese punto es que tu programa no a podido negociar la conexión con el servidor de hacienda, es decir el protocolo que estan utilizando es diferente. Nosotros cuando empezamos las pruebas nos ocurria algo parecido al hacer los envíos y tampoco llegaba al evento OnNeedClientCertificate, pero si nos mostraba el error, que era distinto. Trabajabamos con el delphi Tokio 10.2.0, es decir la primera que sacaron.

Mirando por internet encontramos lo siguiente https://edn.embarcadero.com/print/44770 es decir que la versión que teniamos no estaba preparada para TLS 1.2 que es lo que recomienda hacienda. Tambien puedes seguir el siguiente enlace https://blog.marcocantu.com/blog/201...ents-1022.html que tambien habla de ello. Actualizamos a delphi 10.2.2 y funciono todo correcto.

Yo lo que te recomiendo es que mires si lo puedes probar en un delphi mas actualizado.

Por otra parte hacienda ha publicado esto.

"Se recomienda hacer uso de protocolos de comunicación seguros con el servicio de entradas, con versiones TLS 1.2 o superiores."

Aunque ahora mismo tienen habilitado el 1.0 y el 1.1, pero me comentaron que puede que luego solo dejen el 1.2 o superior. Para indicarle al componente TNEtHttpClient que trabaje con la verisión del protocolo que nosotros queremos es

Código Delphi [-]Componente.SecureProtocols := [THTTPSecureProtocol.TLS12];

Esta propiedad solo esta disponible a partir de la version 10.2.2(Tokio) de delphi.

Un Saludo.

elcharlie · #10 05-11-2020

Cita:

Empezado por juramisa

¿Serías tan amable de mandarme ese procedimiento en la versión Rio?. Viéndolo, parece que es un problema al cargar la lista de los certificados presentes en el ordenador.
¿Tal vez hay una orden previa para la carga de los certificados y que yo no la esté realizando?
Gracias.

Te lo envío, pero sigo creyendo que éste no es el problema, el problema lo tienes en otra parte.

Código Delphi [-]procedure TWinHTTPClient.DoGetClientCertificates(const ARequest: THTTPRequest;
  const ACertificateList: TList);
var
  LRequest: TWinHTTPRequest;
  LStore: HCERTSTORE;
  LIssuerList: PSecPkgContext_IssuerListInfoEx;
  LClientCert: PCCERT_CONTEXT;
  LSearchCriteria: CERT_CHAIN_FIND_BY_ISSUER_PARA;
  LIssuerListSize: DWORD;
  LPrevChainContext, LClientCertChain: PCCERT_CHAIN_CONTEXT;

  procedure AddToCertificateList(const AClientCert: PCCERT_CONTEXT);
  var
    LCertificate: TCertificate;
  begin
    CertDuplicateCertificateContext(AClientCert); // Need to be released (CertFreeCertificateContext)
    CryptCertToTCertificate(AClientCert, LCertificate);
    FCertificateList.Add(LCertificate);
    FWinCertList.Add(AClientCert);
  end;
begin
  inherited;

  if FWinCertList.Count = 0 then
  begin
    LRequest := TWinHTTPRequest(ARequest);

    LIssuerList := nil;
    LIssuerListSize := SizeOf(LIssuerList);
    LStore := TWinHttpLib.GetCertStore;

    if WinHttpQueryOption(LRequest.FWRequest, WINHTTP_OPTION_CLIENT_CERT_ISSUER_LIST, LIssuerList, LIssuerListSize) and (LIssuerList <> nil) then
    begin
      FillChar(LSearchCriteria, SizeOf(LSearchCriteria), 0);
      LSearchCriteria.cbSize := SizeOf(LSearchCriteria);
      LSearchCriteria.cIssuer := LIssuerList.cIssuers;
      LSearchCriteria.rgIssuer := LIssuerList.aIssuers;

      if LStore <> nil then
      begin
        LPrevChainContext := nil;
        while True do
        begin
          LClientCertChain := CertFindChainInStore(LStore, X509_ASN_ENCODING,
            CERT_CHAIN_FIND_BY_ISSUER_CACHE_ONLY_URL_FLAG or CERT_CHAIN_FIND_BY_ISSUER_CACHE_ONLY_FLAG,
            CERT_CHAIN_FIND_BY_ISSUER, @LSearchCriteria, LPrevChainContext);

          if LClientCertChain <> nil then
          begin
            LPrevChainContext := LClientCertChain;
            LClientCert := LClientCertChain.rgpChain^.rgpElement^.pCertContext;
            AddToCertificateList(LClientCert);
          end else
            Break;
        end;
      end;
      GlobalFree(HGLOBAL(LIssuerList));
    end else
    begin
      if LStore <> nil then
      begin
        LClientCert := nil;
        while True do
        begin
          LClientCert := CertFindCertificateInStore(LStore,
            X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
            0, CERT_FIND_ANY, nil, LClientCert);
          if LClientCert <> nil then
            AddToCertificateList(LClientCert)
          else
            Break;
        end;
      end;
    end;
  end;
  ACertificateList.Clear;
  ACertificateList.AddRange(FCertificateList);
end;

Herramientas	Buscar en Tema
Mostrar Versión Imprimible Enviar por Correo	Buscar en Tema: Búsqueda Avanzada
Desplegado
Cambiar a Modo Lineal Modo Híbrido Cambiar a Modo Hilado

Temas Similares
Tema	Autor	Foro	Respuestas	Último mensaje
SII -Nuevo sistema de la Agencia Tributaria española de envío de datos vía Webservice	newtron	Internet	3716	19-01-2026 20:01:34
Como utilizar la ayuda del nuevo Sistema Operativo	gluglu	Humor	3	24-09-2007 09:39:05
Aplicacion Agencia De Viajes	ArdiIIa	Varios	9	20-01-2007 16:49:53
El Vasco Aguirre	Al González	La Taberna	5	26-05-2006 09:22:28
Microsoft ha lanzado su nuevo sistema operativo	DarkByte	Humor	0	25-01-2004 09:21:14