error de certificado al enviar 'muchos' registros

[pablog2k]

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

[pablog2k]

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

[pablog2k]

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

[pablog2k]

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

[pablog2k]

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

[seccion_31]

Empezado por pablog2k

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.

[[newtron]]

Empezado por pablog2k

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

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

[pablog2k]

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;

[[newtron]]

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


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.