Ver Mensaje Individual
  #8  
Antiguo 06-11-2025
pablog2k pablog2k is offline
Miembro
 
Registrado: may 2017
Posts: 241
Reputación: 10
pablog2k Va por buen camino
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;
Responder Con Cita