error de certificado al enviar 'muchos' registros
 

Buenas, estoy utilizando delphi xe, componente THTTPRIO, y haciendo la llamada a la librería que se importa desde los WSDL, concretamente a :
function GetsfPortTypeVerifactu(UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO): sfPortTypeVerifactu;

La cuestión es que me había funcionado bien siempre, pero me he encontrado con un envío de unos 60 registros, y al hacer el envío me dice:
Se requiere un certificado para completar la autenticación de cliente - URL:[https://prewww1.aeat.es/wlpl/TIKE-CO.../VerifactuSOAP) - SOAPAction:""

Si hago envíos de menos registros, me funciona sin problemas
No se si es algo del propio componente THTTPRIO , o de delphi XE....

Me pasa tanto en pre producción como en producción

:confused:

añado que el xml que envío es correcto, ya que he hecho el envío desde la propia web de verifactu de los endpoints y me ha devuelto ok con las facturas subidas

veo que es el mismo problema que pasaba en el SII hace unos años....
alguien lo consiguió resolver sin utilizar los CAPICOM?

vale ya encontré el problema, es el tamaño del buffer del componente SOAPHTTPTrans en la funcion THTTPReqResp.Send
Cuando lo solucione lo pondré, por si alguien mas le pasa

Bueno perdonad por tantos posts.....

Si a alguien le pasa, y está usando el componente SOAPHTTPTrans de delphi XE, yo he modificado en su función THTTPReqResp.Send, hay un momento que separa código según if BuffSize > FMaxSinglePostSize
Si es false (xml 'pequeño'), asigna certificado OK, pero si es true, se pone a montar un buffer , y el problema es que hace Check(not HttpSendRequestEx(Request, @INBuffer, nil,0(*HSR_INITIATE or *), 0)) antes de asignar el certificado, con lo cual da error.
Yo lo he solucionado asignando el certificado antes del Check, y todo OK

me quito el sombrero, enhorabuena.

¿Puedes poner la parte del código por si nos hace falta?

claro, en negrita lo que he añadido

Código Delphi [-]
function THTTPReqResp.Send(const ASrc: TStream): Integer;
const
  ContentTypeFormat: array[Boolean] of string = (ContentTypeTemplate, ContentTypeWithActionFmt);

  { Missing from our WinInet currently }
  INTERNET_OPTION_CLIENT_CERT_CONTEXT = 84;
var
  Request: HINTERNET;
  RetVal, Flags: DWord;
  ActionHeader: string;
  ContentHeader: string;
  BuffSize, Len: Integer;
  INBuffer: INTERNET_BUFFERS;
  Buffer: TMemoryStream;
  WinInetResult: BOOL;
{$IFDEF UNICODE}
  DatStr: TBytesStream;
{$ELSE}
  DatStr: TStringStream;
{$ENDIF}
  UseSendRequestEx: Boolean;
begin
  { Connect }
  Connect(True);

  Flags := INTERNET_FLAG_KEEP_CONNECTION or INTERNET_FLAG_NO_CACHE_WRITE;
  if FURLScheme = INTERNET_SCHEME_HTTPS then
  begin
    Flags := Flags or INTERNET_FLAG_SECURE;
    if (soIgnoreInvalidCerts in InvokeOptions) then
      Flags := Flags or (INTERNET_FLAG_IGNORE_CERT_CN_INVALID or
                         INTERNET_FLAG_IGNORE_CERT_DATE_INVALID or
                         SECURITY_FLAG_IGNORE_UNKNOWN_CA or
                         SECURITY_FLAG_IGNORE_REVOCATION);
  end;

  Request := nil;
  try
    Request := HttpOpenRequest(FInetConnect, 'POST', PChar(FURLSite), nil,
                               nil, nil, Flags, 0{Integer(Self)});
    Check(not Assigned(Request));

    { Timeouts }
    if FConnectTimeout > 0 then
      Check(not InternetSetOption(Request, INTERNET_OPTION_CONNECT_TIMEOUT, Pointer(@FConnectTimeout), SizeOf(FConnectTimeout)));
    if FSendTimeout > 0 then
      Check(not InternetSetOption(Request, INTERNET_OPTION_SEND_TIMEOUT, Pointer(@FSendTimeout), SizeOf(FSendTimeout)));
    if FReceiveTimeout > 0 then
      Check(not InternetSetOption(Request, INTERNET_OPTION_RECEIVE_TIMEOUT, Pointer(@FReceiveTimeout), SizeOf(FReceiveTimeout)));

    if (soIgnoreInvalidCerts in InvokeOptions) then
      InternetSetOption(Request, INTERNET_OPTION_SECURITY_FLAGS, Pointer(@Flags), Sizeof(Flags));

    { Setup packet based on Content-Type/Binding }
    if FBindingType = btMIME then
    begin
      ContentHeader := Format(ContentHeaderMIME, [FMimeBoundary]);
      ContentHeader := Format(ContentTypeTemplate, [ContentHeader]);
      HttpAddRequestHeaders(Request, PChar(MIMEVersion), Length(MIMEVersion), HTTP_ADDREQ_FLAG_ADD);
    end
    else { Assume btSOAP }
      ContentHeader := Format(ContentTypeTemplate, [GetContentType]);

    { Action header }
    if (FBindingType = btMIME) or
       (not (soNoSOAPActionHeader in FInvokeOptions) and not (wnoSOAP12 in GetWebNodeOptions)) then
    begin
      { NOTE: It's not really clear whether this should be sent in the case
              of MIME Binding. Investigate interoperability ?? }
      ActionHeader := GetSOAPActionHeader;
      HttpAddRequestHeaders(Request, PChar(ActionHeader), Length(ActionHeader), HTTP_ADDREQ_FLAG_ADD);
    end;


    { Content-Type }
    HttpAddRequestHeaders(Request, PChar(ContentHeader), Length(ContentHeader), HTTP_ADDREQ_FLAG_ADD);

    { Before we pump data, see if user wants to handle something - like set Basic-Auth data?? }
    if Assigned(FOnBeforePost) then
      FOnBeforePost(Self, Request);

    ASrc.Position := 0;
    BuffSize := ASrc.Size;
    if BuffSize > FMaxSinglePostSize then
    begin
      UseSendRequestEx := True;

      Buffer := TMemoryStream.Create;
      try
        Buffer.SetSize(FMaxSinglePostSize);

        { Init Input Buffer }
        INBuffer.dwStructSize := SizeOf(INBuffer);
        INBuffer.Next := nil;
        INBuffer.lpcszHeader := nil;
        INBuffer.dwHeadersLength := 0;
        INBuffer.dwHeadersTotal := 0;
        INBuffer.lpvBuffer := nil;
        INBuffer.dwBufferLength := 0;
        INBuffer.dwBufferTotal := BuffSize;
        INBuffer.dwOffsetLow := 0;
        INBuffer.dwOffsetHigh := 0;

        while UseSendRequestEx do
        begin
          ASrc.Position := 0;

          { Don't assume we're coming back }
          UseSendRequestEx := False;

          InternetSetOption(Request, INTERNET_OPTION_CLIENT_CERT_CONTEXT, SOAP_PTR_CERTIFICADO, SizeOf(CERT_CONTEXT) );

          { Start POST }
          Check(not HttpSendRequestEx(Request, @INBuffer, nil,
                                      0(*HSR_INITIATE or HSR_SYNC*), 0));
          try
            while True do
            begin
              { Calc length of data to send }
              Len := BuffSize - ASrc.Position;
              if Len > FMaxSinglePostSize then
                Len := FMaxSinglePostSize;
              { Bail out if zip.. }
              if Len = 0 then
                break;
              { Read data in buffer and write out}
              Len := ASrc.Read(Buffer.Memory^, Len);
              if Len = 0 then
                raise ESOAPHTTPException.Create(SInvalidHTTPRequest);


              RetVal := ERROR_SUCCESS;
              if not InternetWriteFile(Request, @Buffer.Memory^, Len, RetVal) then
                RetVal := HandleWinInetError(GetLastError, Request);

              case RetVal of
                ERROR_SUCCESS:;
                ERROR_CANCELLED: SysUtils.Abort;
                ERROR_INTERNET_FORCE_RETRY: {Retry the operation};
              end;

              { Posting Data Event }
              if Assigned(FOnPostingData) then
                FOnPostingData(ASrc.Position, BuffSize);
            end;
          finally
            RetVal := ERROR_SUCCESS;
            if not HttpEndRequest(Request, nil, 0, 0) then
                RetVal := HandleWinInetError(GetLastError, Request);

            case RetVal of
              ERROR_SUCCESS: ;
              ERROR_CANCELLED: SysUtils.Abort;
              ERROR_INTERNET_FORCE_RETRY:
                { We're going back again pal:( }
                { See the following URL:
                http://www.archivum.info/microsoft.p...HttpEndRequest
                }
                UseSendRequestEx := True;
            end;
          end;
        end;
      finally
        Buffer.Free;
      end;
    end else
    begin
{$IFDEF UNICODE}
      DatStr := TBytesStream.Create;
{$ELSE}
      DatStr := TStringStream.Create('');
{$ENDIF}
      try
        DatStr.CopyFrom(ASrc, 0);
        while True do
        begin

          { Posting Data Event }
          if Assigned(FOnPostingData) then
            FOnPostingData(DatStr.Size, BuffSize);

          RetVal := ERROR_SUCCESS;
{$IFDEF UNICODE}
          WinInetResult := HttpSendRequest(Request, nil, 0,
                                           DatStr.Bytes, DatStr.Size);
{$ELSE}
          WinInetResult := HttpSendRequest(Request, nil, 0,
                                           @DatStr.DataString[1],
                                           Length(DatStr.DataString));
{$ENDIF}

          if not WinInetResult then
            RetVal := HandleWinInetError(GetLastError, Request);

          case RetVal of
            ERROR_SUCCESS: break;
            ERROR_CANCELLED: SysUtils.Abort;
            ERROR_INTERNET_FORCE_RETRY: {Retry the operation};
          end;
        end;
      finally
        DatStr.Free;
      end;
    end;
  except
    if (Request <> nil) then
      InternetCloseHandle(Request);
    Connect(False);
    raise;
  end;
  Result := Integer(Request);
end;

Ups.... Me estoy percatando de que yo uso HTTPRIO y esa ñapa no me va a servir. :confused:


El caso es que a mi me ha pasado en alguna ocasión pero de repente desapareció el problema. Si me vuelve a pasar revisaré si el HTTPRIO funciona de forma similar y puedo hacer lo mismo que tú.


Gracias y un saludo.