The handle is in the wrong state for the requested operation

I get that error, followed by the URL of the web service.
I found a possible solution in the C++ Builder section of this forum but I am not sure how to translate it to delphi.
Please do that for me (and others who encountered this error):

This is the error handler... and I need (besides the translation) to know exactly where to catch the error:

unsigned long __fastcall
TTestForm::FixWinInetError(unsigned LastError, void* Request)
{
  if (LastError != 0)
  {
    System::String msg;
    msg.sprintf(L"HTTTP Error: %d", LastError);
    if ((LastError > INTERNET_ERROR_BASE) &&
        (LastError <= INTERNET_ERROR_LAST)) {
      LPWSTR lpBuffer;
      int i = ::FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER|
                 FORMAT_MESSAGE_FROM_HMODULE,
                 ::GetModuleHandleW(L"wininet.dll"),
                 LastError, 0,
                 (LPWSTR)&lpBuffer, 0, 0);
      if (i) {
        msg.sprintf(L"%s: %d", lpBuffer, LastError);
        ::LocalFree(lpBuffer);
      }
    }
    throw Soaphttptrans::ESOAPHTTPException(msg, LastError, 0);
  }
  return ERROR_SUCCESS;
}
0
Softwarex
5/9/2011 7:32:26 AM
embarcadero.delphi.webservices 976 articles. 0 followers. Follow

20 Replies
5028 Views

Similar Articles

[PageSpeed] 45

I am (almost) in the exact same situation !
Help needed !!
The property HTTPWebNode of the HTTPRIO component has an event called OnWinInetError - this is where the code should be.
But I don't understand the C-code and I don't know which units to include.

René


> {quote:title=Softwarex.ro Administrator wrote:}{quote}
> I get that error, followed by the URL of the web service.
> I found a possible solution in the C++ Builder section of this forum but I am not sure how to translate it to delphi.
> Please do that for me (and others who encountered this error):
> 
> This is the error handler... and I need (besides the translation) to know exactly where to catch the error:
> 
> unsigned long __fastcall
> TTestForm::FixWinInetError(unsigned LastError, void* Request)
> {
>   if (LastError != 0)
>   {
>     System::String msg;
>     msg.sprintf(L"HTTTP Error: %d", LastError);
>     if ((LastError > INTERNET_ERROR_BASE) &&
>         (LastError <= INTERNET_ERROR_LAST)) {
>       LPWSTR lpBuffer;
>       int i = ::FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER|
>                  FORMAT_MESSAGE_FROM_HMODULE,
>                  ::GetModuleHandleW(L"wininet.dll"),
>                  LastError, 0,
>                  (LPWSTR)&lpBuffer, 0, 0);
>       if (i) {
>         msg.sprintf(L"%s: %d", lpBuffer, LastError);
>         ::LocalFree(lpBuffer);
>       }
>     }
>     throw Soaphttptrans::ESOAPHTTPException(msg, LastError, 0);
>   }
>   return ERROR_SUCCESS;
> }
0
Rene
5/11/2011 7:53:24 AM
Am 09.05.2011, 09:32 Uhr, schrieb Softwarex.ro Administrator :

> I get that error, followed by the URL of the web service.
> I found a possible solution in the C++ Builder section of this forum but I am not sure how to translate it to delphi.
> Please do that for me (and others who encountered this error):
>
> This is the error handler... and I need (besides the translation) to know exactly where to catch the error:
>
> unsigned long __fastcall
> TTestForm::FixWinInetError(unsigned LastError, void* Request)
> {
>   if (LastError != 0)
>   {
>     System::String msg;
>     msg.sprintf(L"HTTTP Error: %d", LastError);
>     if ((LastError > INTERNET_ERROR_BASE) &&
>         (LastError <= INTERNET_ERROR_LAST)) {
>       LPWSTR lpBuffer;
>       int i = ::FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER|
>                  FORMAT_MESSAGE_FROM_HMODULE,
>                  ::GetModuleHandleW(L"wininet.dll"),
>                  LastError, 0,
>                  (LPWSTR)&lpBuffer, 0, 0);
>       if (i) {
>         msg.sprintf(L"%s: %d", lpBuffer, LastError);
>         ::LocalFree(lpBuffer);
>       }
>     }
>     throw Soaphttptrans::ESOAPHTTPException(msg, LastError, 0);
>   }
>   return ERROR_SUCCESS;
> }

Does this help:
https://forums.embarcadero.com/thread.jspa?threadID=39507

Stefan
0
Stefan
5/11/2011 11:25:14 AM
> {quote:title=Stefan Huber wrote:}{quote}

> Does this help:
> https://forums.embarcadero.com/thread.jspa?threadID=39507
> 
> Stefan

NO ! That thread is the SOURCE of the solution in C that we are referring to !!
We want a translation to Delphi !

René
0
Rene
5/11/2011 11:43:11 AM
Hello,

The source I posted in that thread was translated from Delphi: I took the 
code from the SOAP runtime, SOAPHTTPTrans.pas, and posted a C++ version (as 
that was on the C++Builder forums); but it's the same runtime and the 
original source is right from SOAP's own runtime. If you don't have a copy 
of the source handy (it ships with Delphi), I'm happy to post the relevant 
portion here. Let us know.

Cheers,

Bruneau
0
Jean
5/11/2011 5:57:14 PM
Hello,

I've posted a patched version of SOAPHTTPTrans.pas that contains a fix for 
this issue here:

   https://forums.embarcadero.com/thread.jspa?messageID=351958

You may still override the event as described in the C++Builder section 
referred; or, much simpler, at least for Delphi users, simply add the 
updated SOAPHTTPTrans.pas to your app's project. Let us know if that does 
not work for you.

Cheers,

Bruneau
0
Jean
5/11/2011 7:25:18 PM
Thank you very much !
One small problem, though.
The file does not contain any linebreaks ?!? 
Which makes it rather unreadable !

René

BTW - I don't know how to mark responses as helful and/or correct 

> {quote:title=Jean-Marie Babet wrote:}{quote}
> Hello,
> 
> I've posted a patched version of SOAPHTTPTrans.pas that contains a fix for 
> this issue here:
> 
>    https://forums.embarcadero.com/thread.jspa?messageID=351958
> 
> You may still override the event as described in the C++Builder section 
> referred; or, much simpler, at least for Delphi users, simply add the 
> updated SOAPHTTPTrans.pas to your app's project. Let us know if that does 
> not work for you.
> 
> Cheers,
> 
> Bruneau
0
Rene
5/12/2011 7:41:05 AM
Hello,


> One small problem, though.
> The file does not contain any linebreaks ?!?
> Which makes it rather unreadable !
>

Umm... My copy has linebreaks. I suspect it's the Forum software messing 
with the text file. So I'm uploading a .zipped up copy of the file. Hope 
this helps:

  https://forums.embarcadero.com/thread.jspa?messageID=352093&tstart=0#352093

Cheers,

Bruneau
0
Jean
5/12/2011 7:51:08 AM
Thank you !

>
 {quote:title=Jean-Marie Babet wrote:}{quote}
> Hello,
> 
> Umm... My copy has linebreaks. I suspect it's the Forum software messing 
> with the text file. So I'm uploading a .zipped up copy of the file. Hope 
> this helps:
> 
>   https://forums.embarcadero.com/thread.jspa?messageID=352093&tstart=0#352093
> 
> Cheers,
> 
> Bruneau
0
Rene
5/12/2011 8:33:25 AM
Thank you .
I will try your solution tomorrow (since I am still out of the office).
I hope all will go well.
Thank you for your fast response Jean-Marie, you are the most important member of this forum.
Rene Laursen, please post your experience with the new code here after you make it work, so that everyone who encounters this problem would benefit from this post.

Best regards
Calin Meze


> {quote:title=Rene Laursen wrote:}{quote}
> Thank you !
> 
> >
>  {quote:title=Jean-Marie Babet wrote:}{quote}
> > Hello,
> > 
> > Umm... My copy has linebreaks. I suspect it's the Forum software messing 
> > with the text file. So I'm uploading a .zipped up copy of the file. Hope 
> > this helps:
> > 
> >   https://forums.embarcadero.com/thread.jspa?messageID=352093&tstart=0#352093
> > 
> > Cheers,
> > 
> > Bruneau
0
Softwarex
5/12/2011 8:52:32 AM
Hello,

>
> Well, the patched unit did not compile in Delphi2010 (perhaps it does in 
> XE ?)
>
> I got
> [DCC Error] SOAPHTTPTrans.pas(397): E2003 Undeclared identifier: 
> 'TInterlocked'
>

Yes, the file I posted was  me applying a patch to the current version (i.e. 
XE) based on what I had found when I researched this issue for the C++ post 
(mentioned in this thread). I'll always assume current version unless 
someone explicitly says the version required (and my apologies if that was 
mentioned and I missed it: I monitor this forum in my spare time).

Unfortunately, I'm not in the office right now so I don't have 2010 handy. 
I'd be happy to post a 2010 version of the patch when time allows next week. 
If someone needs a solution for 2010 sooner, you can try the following:

A) Keep the 2010 version of SOAPHTTPTrans.pas
B) Add/merge in the THTTPReqRespHelper class from the patched XE file (i.e. 
add the class helper and its two methods)
C) Merge the changes made to THTTPReqResp.Check, 
THTTPReqResp.HandleWinInetError from the patch.

D) For THTTPReqResp.Send only take the changes where the call to 
HandleWinInetError were changed to call HandleWinInetErrorEx.

I have not tried the above but will do so next week and report my findings 
here.

Cheers,

Bruneau
0
Jean
5/14/2011 1:21:22 AM
> {quote:title=Jean-Marie Babet wrote:}{quote}
> Yes, the file I posted was  me applying a patch to the current version (i.e. 
> XE) based on what I had found when I researched this issue for the C++ post 
> (mentioned in this thread). I'll always assume current version unless 
> someone explicitly says the version required (and my apologies if that was 
> mentioned and I missed it: I monitor this forum in my spare time).

Hi Jean-Marie
(I have cross-mailed you directly - when the Forum was under maintenance - but for the thead I repeat here)

I will be very happy if you make a Delphi2010 version of the patch, when you have the time.

You are correct I did not state my Delphi-version, sorry. The thread was not mine from the start - I just had the same problem. 

Thank you so far
René
0
Rene
5/16/2011 9:58:36 AM
> {quote:title=Jean-Marie Babet wrote:}{quote}
> Hello,
> Unfortunately, I'm not in the office right now so I don't have 2010 handy. 
> I'd be happy to post a 2010 version of the patch when time allows next week. 
....
> Cheers,
> 
> Bruneau

Hi 
I Hope you're still willing to post a Delphi 2010 patch, when you have the time
Best regards
René/SSV
0
Rene
5/23/2011 9:05:29 AM
Yes, I'll try to get to that sometime today. (We're in the middle of 
releasing another milestone, so time for monitoring the forum has been hard 
to come by lately).

Cheers,

Bruneau
0
Jean
5/23/2011 5:14:43 PM
Hello,

Below is a patched version of the *2010* version of SOAPHTTPTrans.pas to 
resolve the problem described in this thread. As with the C++ patch, I'll 
illustrate the problem. You can see the problem in a simple Button Click 
handler. For example:


{code}
const
  Request =
  '<?xml version="1.0"?>' +
  '<SOAP-ENV:Envelope ' +
  ' xmlns:SOAP-ENV='+
  '"http://schemas.xmlsoap.org/soap/envelope/">' +
  ' <SOAP-ENV:Body>' +
  '  <x_Person xmlns="http://soapinterop.org/xsd" ' +
  '      Name="ЗАКУСКИ" ' +
  '      Male="true"> ' +
  '    <Age>45.5</Age>' +
  '    <ID>1234.5678</ID>' +
  '  </x_Person>' +
  ' </SOAP-ENV:Body>' +
  '</SOAP-ENV:Envelope>';

const URL= 'http://mssoapinterop.org/asmx/wsdl/compound1.asmx';


procedure TForm29.InvokeEchoPersonClick(Sender: TObject);
var
  RR: THTTPReqResp;
  Response: TMemoryStream;
  U8: UTF8String;
begin
  RR := THTTPReqResp.Create(nil);
  try
    RR.URL := URL;
    RR.UseUTF8InHeader := True;
    RR.SoapAction := 'http://soapinterop/echoPerson';
    Response := TMemoryStream.Create;
    try
      RR.Execute(Request, Response);
      SetLength(U8, Response.Size);
      Response.Position := 0;
      Response.Read(U8[1], Length(U8));
      ShowMessage(U8);
    finally
      Response.Free;
    end;
  finally
    RR.Free;
  end;
end;
{code}

The above example invokes the EchoPerson service available here - 
http://mssoapinterop.org/asmx/wsdl/compound1.asmx. The response comes back 
nicely and is displayed in a MessageBox. Now, update the URL variable to 
something invalid, such as http://mssoapintero.org/asmx/wsdl/compound1.asmx. 
(NOTE: I've dropped the ending 'p' on the domain name). When you run you 
should get an error message about being unable to resolve the server name. 
Instead, you get an empty MessageBox. The issue is that the code failed to 
probably catch the fact that the HTTP POST failed. In this case, we're 
failing to connect. But let's say we have a case where we can connect but 
the Server is too busy and it cannot process the posted data. The 'Send' 
will fail. However, the runtime will fail to detect this and it will process 
to receiving the response - at which point WinInet will say "Handle is in 
the wrong state for the requested operation".

So the core issue is the failure to detect a failed WinInet operation. The 
updated SOAPHTTPTrans.pas below remedies.

Cheers,

Bruneau

{code}
{*******************************************************}
{                                                       }
{            Delphi Visual Component Library            }
{         SOAP Transports                               }
{                                                       }
{ Copyright(c) 1995-2010 Embarcadero Technologies, Inc. }
{                                                       }
{*******************************************************}

unit SOAPHTTPTrans;

{$IFDEF LINUX}
  {$DEFINE USE_INDY}
{$ENDIF}
{$IFDEF MSWINDOWS}
//  {$DEFINE USE_INDY}
{$ENDIF}

{$IFNDEF VER150}
{$INCLUDE 'CompVer.inc'}
{$ENDIF}

{$IFDEF HIGHLANDER_UP}
  {$DEFINE INDY_CUSTOM_IOHANDLER}
{$ENDIF}

{$IFDEF TIBURON_UP}
  // Default to v10 of Indy for Tiburon and up unless INDY_9 is defined
  {$IFNDEF INDY_9}
    {$DEFINE INDY_10}
  {$ENDIF}
{$ENDIF}

interface

uses
  SysUtils, Classes, WebNode, WSDLNode, Types, IntfInfo, WSDLIntf, 
SOAPAttachIntf,
{$IFDEF USE_INDY}
IdHTTP, IdIOHandler, IdIOHandlerSocket, IdSSLOpenSSL;
{$ELSE}
  WinSock, WinInet;
(*$HPPEMIT '#pragma link "wininet.lib"' *)
{$ENDIF}
type

  ESOAPHTTPException = class(Exception)
  private
    FStatusCode: Integer;
  public
{$IF CompilerVersion <= 15.0}
    constructor Create(const Msg: string; SCode: Integer = 0);
{$ELSE}
    constructor Create(const Msg: string; SCode: Integer = 0; Dummy: Integer 
= 0);
{$IFEND}
    constructor CreateFmt(const Msg: string; const Args: array of const; 
SCode: Integer = 0; Dummy: Integer = 0);

    property StatusCode: Integer read FStatusCode write FStatusCode;
  end;

  SOAPInvokeOptions = (soNoValueForEmptySOAPAction,   { Send "" or 
absolutely no value for empty SOAPAction }
                       soIgnoreInvalidCerts,          { Handle Invalid 
Server Cert and ask HTTP runtime to ignore }
                       soNoSOAPActionHeader,          { Don't send 
SOAPAction - use very very carefully!! }
                       soAutoCheckAccessPointViaUDDI, { if we get a status 
code 404/405/410 - contact UDDI }
                       soPickFirstClientCertificate   { WinInet Only }
                       );
  TSOAPInvokeOptions= set of SOAPInvokeOptions;

  THTTPReqResp = class;

  { Provides access to HTTPReqResp component }
  IHTTPReqResp = interface
  ['{5FA6A197-32DE-4225-BC85-216CB80D1561}']
    function GetHTTPReqResp: THTTPReqResp;
  end;

  TBeforePostEvent = procedure(const HTTPReqResp: THTTPReqResp; Data: 
Pointer) of object;
  TPostingDataEvent= procedure(Sent: Integer; Total: Integer) of object;
  TReceivingDataEvent= procedure(Read: Integer; Total: Integer) of object;
  TWinInetErrorEvent = function(LastError: DWord; Request: Pointer): DWord 
of object;

  THTTPReqResp = class(TComponent, IInterface, IWebNode, IHTTPReqResp)
  private
    FUserSetURL: Boolean;
    FRefCount: Integer;
    FOwnerIsComponent: Boolean;
    FConnected: Boolean;
    FURL: string;
    FAgent: string;
    FBindingType: TWebServiceBindingType;
    FMimeBoundary: string;
    FWebNodeOptions: WebNodeOptions;
    FContentType: string;
    FUserName: string;
    FPassword: string;
    FURLHost: string;
    FURLSite: string;
    FURLPort: Integer;
    FURLScheme: Integer;
    FProxy: string;
    FProxyByPass: string;
{$IFNDEF USE_INDY}
    FInetRoot: HINTERNET;
    FInetConnect: HINTERNET;
{$ENDIF}
    FConnectTimeout: Integer;
    FSendTimeout: Integer;
    FReceiveTimeout: Integer;
    FWSDLView: TWSDLView;
    FSoapAction: string;
    FUseUTF8InHeader: Boolean;
    FInvokeOptions: TSOAPInvokeOptions;
    FUDDIBindingKey: WideString;
    FUDDIOperator: String;
    FOnBeforePost: TBeforePostEvent;
    FOnPostingData: TPostingDataEvent;
    FOnReceivingData: TReceivingDataEvent;
    FMaxSinglePostSize: Integer;
    FOnWinInetError: TWinInetErrorEvent;

{$IFDEF USE_INDY}
  {$IFDEF INDY_CUSTOM_IOHANDLER}
    FIOHandler: TIdIOHandler;
  {$ENDIF}
{$ENDIF}

    procedure SetURL(const Value: string);
    function  GetSOAPAction: string;
    procedure SetSOAPAction(const SOAPAction: string);
    procedure SetWSDLView(const WSDLVIew: TWSDLView);
    function  GetSOAPActionHeader: string;
    procedure InitURL(const Value: string);
    procedure SetUsername(const NameValue: string);
    procedure SetPassword(const PasswordValue: string);
    procedure SetProxy(const ProxyValue: string);
{$IFDEF DEXTER_UP}
    function  GetAgentIsStored:Boolean;
{$ENDIF}
  protected
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function GetMimeBoundary: string;
    procedure SetMimeBoundary(Value: string);
    function  GetWebNodeOptions: WebNodeOptions;
    procedure SetWebNodeOptions(Value: WebNodeOptions);
  public
    constructor Create(Owner: TComponent); override;
    class function NewInstance: TObject; override;
    procedure AfterConstruction; override;
    destructor Destroy; override;
    function  GetHTTPReqResp: THTTPReqResp;
    procedure CheckContentType;
{$IFNDEF USE_INDY}
    procedure Check(Error: Boolean; ShowSOAPAction: Boolean = False);
    procedure Connect(Value: Boolean);
    function  Send(const ASrc: TStream): Integer; virtual;
    function  SendGet: Integer; virtual;
    procedure Receive(Context: Integer; Resp: TStream; IsGet: Boolean = 
False); virtual;
    function  HandleWinInetError(LastError: DWord; Request: HINTERNET): 
DWord;
{$ENDIF}
{$IFDEF USE_INDY}
    procedure SetupIndy(IndyHttp: TIDHttp; Request: TStream);
{$ENDIF}
    procedure Get(Resp: TStream); virtual;
    {IWebNode}
    procedure BeforeExecute(const IntfMD: TIntfMetaData;
                            const MethMD: TIntfMethEntry;
                            MethodIndex: Integer;
                            AttachHandler: IMimeAttachmentHandler);
    procedure Execute(const DataMsg: String; Resp: TStream); overload; 
virtual;
    procedure Execute(const Request: TStream; Response: TStream); overload; 
virtual;
    function  Execute(const Request: TStream): TStream; overload; virtual;
    property  URL: string read FURL write SetURL;
    property  SoapAction: string read GetSOAPAction write SetSOAPAction;
    { Can these be exposed when using Indy too?? }
    property  ConnectTimeout: Integer read FConnectTimeout write 
FConnectTimeout;
    property  SendTimeout: Integer read FSendTimeout write FSendTimeout;
    property  ReceiveTimeout: Integer read FReceiveTimeout write 
FReceiveTimeout;
    property  MaxSinglePostSize: Integer read FMaxSinglePostSize write 
FMaxSinglePostSize;

{$IFDEF USE_INDY}
  {$IFDEF INDY_CUSTOM_IOHANDLER}
    property IOHandler: TIdIOHandler read FIOHandler write FIOHandler;
  {$ENDIF}
{$ENDIF}

  published
    property  WSDLView: TWSDLView read FWSDLView write SetWSDLView;
{$IFDEF DEXTER_UP}
    property  Agent: string read FAgent write FAgent stored 
GetAgentIsStored;
{$ELSE}
    property  Agent: string read FAgent write FAgent;
{$ENDIF}
    property  UserName: string read FUserName write SetUserName;
    property  Password: string read FPassword write SetPassword;
    property  Proxy: string read FProxy write SetProxy;
    property  ProxyByPass: string read FProxyByPass write FProxyByPass;
{$IFDEF DEXTER_UP}
    property  UseUTF8InHeader: Boolean read FUseUTF8InHeader write 
FUseUTF8InHeader default False;
{$ELSE}
    property  UseUTF8InHeader: Boolean read FUseUTF8InHeader write 
FUseUTF8InHeader;
{$ENDIF}
    property  InvokeOptions: TSOAPInvokeOptions read FInvokeOptions write 
FInvokeOptions;
    property  WebNodeOptions: WebNodeOptions read FWebNodeOptions write 
FWebNodeOptions;
    property  UDDIBindingKey: WideString read FUDDIBindingKey write 
FUDDIBindingKey;
    property  UDDIOperator: String read FUDDIOperator write FUDDIOperator;

    { Events }
    property  OnBeforePost: TBeforePostEvent read FOnBeforePost write 
FOnBeforePost;
    property  OnPostingData: TPostingDataEvent read FOnPostingData write 
FOnPostingData;
    property  OnReceivingData: TReceivingDataEvent read FOnReceivingData 
write FOnReceivingData;
    property  OnWinInetError: TWinInetErrorEvent read FOnWinInetError write 
FOnWinInetError;
  end;

  { Since we cannot modify THTTPReqResp for the update but want to add
    support for a Client Serial Number, we'll slip this through the
    backdoor }
  IClientCertInfo = interface
  ['{4EA73902-DD19-4952-A94D-CCCE7B995F5C}']
    function GetCertSerialNumber: string;
    procedure SetCertSerialNumber(const ASerialNum: string);
    function GetCertName: string;
    procedure SetCertName(const AName: string);
    function GetCertIssuer: string;
    procedure SetCertIssuer(const AIssuer: string);
    function GetCertStore: Pointer;
    procedure SetCertStore(APointer: Pointer);
    function GetCertContext: Pointer;
    procedure SetCertContext(AContext: Pointer);
  end;


implementation


uses Variants, SOAPConst, XMLDoc, XMLIntf, InvokeRegistry, WSDLItems,
     SOAPAttach, UDDIHelper,
{$IFDEF MSWINDOWS}
     Windows,
  {$IFDEF CLIENT_CERTIFICATE_SUPPORT}
    {$IFDEF HAS_CERTHELPER}
     CertHelper,
    {$ENDIF}
  {$ENDIF}
{$ENDIF}
{$IFNDEF USE_INDY}
     xmldom;
{$ELSE}
  {$IFDEF INDY_10}
     IdAssignedNumbers,
  {$ENDIF}
     IdIntercept, IdException, IdURI, IdGlobal, IdHeaderList, 
IdHTTPHeaderInfo;
{$ENDIF}


{$IFDEF CLIENT_CERTIFICATE_SUPPORT}
  {$IFNDEF HAS_CERTHELPER}
    {$DEFINE INLINE_CERTHELPER}
    {$INCLUDE 'CompVer.inc'}
  {$ENDIF}
{$ENDIF}

const
  SOAP_AGENT = 'CodeGear SOAP 1.3'; { Do not localize }

{$IFDEF USE_INDY}
procedure ParseURI(AURI: string; var VProtocol, VHost, VPath, VDocument,
                       VPort, VBookmark : string);
var
  URI: TIdURI;
begin
  URI := TIdURI.Create(AURI);
  try
    VProtocol := URI.Protocol;
    VHost := URI.Host;
    VPath := URI.Path;
    VDocument := URI.Document;
    VPort := URI.Port;
    VBookmark := URI.Bookmark;
  finally
    URI.Free;
  end;
end;
{$ENDIF}

{$IF CompilerVersion <= 15.0}
constructor ESOAPHTTPException.Create(const Msg: string; SCode: Integer = 
0);
{$ELSE}
constructor ESOAPHTTPException.Create(const Msg: string; SCode: Integer = 0; 
Dummy: Integer = 0);
{$IFEND}
begin
  inherited Create(Msg);
  FStatusCode := SCode;
end;

constructor ESOAPHTTPException.CreateFmt(const Msg: string; const Args: 
array of const; SCode: Integer; Dummy: Integer);
begin
  inherited CreateFmt(Msg, Args);
  FStatusCode := SCode;
end;

constructor THTTPReqResp.Create(Owner: TComponent);
begin
  inherited;
{$IFNDEF USE_INDY}
  FInetRoot := nil;
  FInetConnect := nil;
{$ENDIF}
  FUserSetURL := False;
  FInvokeOptions := [soIgnoreInvalidCerts, soAutoCheckAccessPointViaUDDI];
  FAgent := SOAP_AGENT;
  FMaxSinglePostSize := $8000;
  { Default this to true to allow Clients to send International Characters 
without having to
    explicit set this.
    NOTE: This is a change from previous versions but it seems better based 
on the number of
          reports whose ultimate solution is related to not having enabled 
this property
          The property still specifies the default as False as we cannot 
break interfaces for
          this release. We'll reconsider the 'default' in a subsequent 
release. }
  FUseUTF8InHeader := True;
end;

destructor THTTPReqResp.Destroy;
begin
{$IFNDEF USE_INDY}
  if Assigned(FInetConnect) then
    InternetCloseHandle(FInetConnect);
  FInetConnect := nil;
  if Assigned(FInetRoot) then
    InternetCloseHandle(FInetRoot);
  FInetRoot := nil;
{$ENDIF}
  FConnected := False;
  inherited;
end;

class function THTTPReqResp.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  THTTPReqResp(Result).FRefCount := 1;
end;

procedure THTTPReqResp.AfterConstruction;
begin
  inherited;
  FOwnerIsComponent := Assigned(Owner) and (Owner is TComponent);
  InterlockedDecrement(FRefCount);
end;

{ IInterface }

function THTTPReqResp._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount)
end;

function THTTPReqResp._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  { If we are not being used as a TComponent, then use refcount to manage 
our
    lifetime as with TInterfacedObject. }
  if (Result = 0) and not FOwnerIsComponent then
    Destroy;
end;

{$IFNDEF USE_INDY}

type
  THTTPReqRespHelper = class helper for THTTPReqResp
  protected
    function  HandleWinInetErrorEx(LastError: DWord; Request: HINTERNET;
                                   RaiseError: Boolean = False): DWord;
    procedure RaiseCheck(ErrCode: DWORD; ShowSOAPAction: Boolean = False);
  end;

procedure THTTPReqResp.Check(Error: Boolean; ShowSOAPAction: Boolean);
var
  ErrCode: Integer;
  S: string;
begin
  if Error then
  begin
    ErrCode := GetLastError;
    if (ErrCode <> 0) then
    begin
      RaiseCheck(ErrCode, ShowSOAPAction);
    end;
  end;
end;

procedure THTTPReqRespHelper.RaiseCheck(ErrCode: DWORD; ShowSOAPAction: 
Boolean);
var
  S: string;
begin
  if (ErrCode <> 0) then
  begin
    SetLength(S, 256);
    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_FROM_HMODULE, 
Pointer(GetModuleHandle('wininet.dll')),
      ErrCode, 0, PChar(S), Length(S), nil);
    SetLength(S, StrLen(PChar(S)));
    while (Length(S) > 0) and CharInSet(S[Length(S)], [#10, #13]) do
      SetLength(S, Length(S) - 1);
    raise ESOAPHTTPException.CreateFmt('%s - URL:%s - SOAPAction:%s', [S, 
FURL, SoapAction], ErrCode);      { Do not localize }
  end;
end;

{$ELSE}
procedure THTTPReqResp.IndyProxyAuthorization(Sender: TObject;
                                              Authentication: 
TIdAuthentication;
                                              var Handled: Boolean);
begin
  Authentication.UserName := FUserName;
  Authentication.Password := FPassword;
  Handled := True;
end;
{$ENDIF}

function THTTPReqResp.GetHTTPReqResp: THTTPReqResp;
begin
  Result := Self;
end;

function THTTPReqResp.GetSOAPAction: string;
begin
  if (FSoapAction = '') and not (soNoValueForEmptySOAPAction in 
FInvokeOptions) then
    Result := '""'
  else
    Result := FSoapAction;
end;

procedure THTTPReqResp.SetSOAPAction(const SOAPAction: string);
begin
  FSoapAction := SOAPAction;
end;

procedure THTTPReqResp.SetWSDLView(const WSDLVIew: TWSDLView);
begin
  FWSDLView := WSDLView;
end;

procedure THTTPReqResp.SetURL(const Value: string);
begin
  if Value <> '' then
    FUserSetURL := True
  else
    FUserSetURL := False;
  InitURL(Value);
{$IFNDEF USE_INDY}
  { Here we always disconnect if a new URL comes in...
    this ensures that we don't keep a connection to
    a wrong host }
  Connect(False);
{$ENDIF}
end;

procedure THTTPReqResp.InitURL(const Value: string);
{$IFNDEF USE_INDY}
var
  URLComp: TURLComponents;
  P: PChar;
{$ELSE}
const
  http = 'http://';
var
  IndyHTTP: TIDHttp;
  URI, Protocol, Host, path, Document, Port, Bookmark: string;
{$ENDIF}
begin
  if Value <> '' then
  begin
{$IFNDEF USE_INDY}
    FillChar(URLComp, SizeOf(URLComp), 0);
    URLComp.dwStructSize := SizeOf(URLComp);
    URLComp.dwSchemeLength := 1;
    URLComp.dwHostNameLength := 1;
    URLComp.dwURLPathLength := 1;
    P := PChar(Value);
    InternetCrackUrl(P, 0, 0, URLComp);
    if not (URLComp.nScheme in [INTERNET_SCHEME_HTTP, 
INTERNET_SCHEME_HTTPS]) then
      raise ESOAPHTTPException.CreateFmt(SInvalidURL, [Value]);
    FURLScheme := URLComp.nScheme;
    FURLPort := URLComp.nPort;
    FURLHost := Copy(Value, URLComp.lpszHostName - P + 1, 
URLComp.dwHostNameLength);
    FURLSite := Copy(Value, URLComp.lpszUrlPath - P + 1, 
URLComp.dwUrlPathLength);
{$ELSE}
    IndyHTTP := TIDHttp.Create(Nil);
    try
      URI := Value;
      ParseURI(URI, Protocol, Host, Path, Document, Port, Bookmark);
      if Port <> '' then
        FURLPort := StrToInt(Port)
      else
{$IFDEF INDY_10}
        FURLPort := IdPORT_HTTP;
{$ELSE}
        FURLPort := IndyHTTP.Port;
{$ENDIF}
      if Host <> '' then
        FURLHost := Host
      else
        FURLHost := Copy(Value, Length(http)+1,
              Pos(':' + IntToStr(FURLPort), Value) - (Length(http)+1));
    finally
      IndyHTTP.Free;
    end;
{$ENDIF}
  end else
  begin
    FURLPort := 0;
    FURLHost := '';
    FURLSite := '';
    FURLScheme := 0;
  end;
  FURL := Value;
end;

procedure THTTPReqResp.SetMimeBoundary(Value: string);
begin
  FMimeBoundary := Value;
end;

function THTTPReqResp.GetMimeBoundary: string;
begin
  Result := FMimeBoundary;
end;

function THTTPReqResp.GetWebNodeOptions: WebNodeOptions;
begin
  Result := FWebNodeOptions;
end;

procedure THTTPReqResp.SetWebNodeOptions(Value: WebNodeOptions);
begin
  FWebNodeOptions := Value;
end;

procedure THTTPReqResp.SetUsername(const NameValue: string);
begin
  FUserName := NameValue;
  if Assigned(WSDLView) then
    WSDLView.UserName := NameValue;
end;

procedure THTTPReqResp.SetPassword(const PasswordValue: string);
begin
  FPassword := PasswordValue;
  if Assigned(WSDLView) then
    WSDLView.Password := PasswordValue;
end;

procedure THTTPReqResp.SetProxy(const ProxyValue: string);
begin
  FProxy := ProxyValue;
  if Assigned(WSDLView) then
    WSDLView.Proxy := ProxyValue;
end;


const
  MaxStatusTest = 4096;
  MaxContentType= 256;

function THTTPReqResp.GetSOAPActionHeader: string;
begin
  if (SoapAction = '') then
    Result := SHTTPSoapAction + ':'
  else if (SoapAction = '""') then
    Result := SHTTPSoapAction + ': ""'
  else
    Result := SHTTPSoapAction + ': ' + '"' + SoapAction + '"';
end;


{$IFNDEF USE_INDY}

procedure THTTPReqResp.Connect(Value: Boolean);
var
  AccessType: Integer;
begin
  if Value then
  begin
    { Yes, but what if we're connected to a different Host/Port?? }
    { So take advantage of a cached handle, we'll assume that
      Connect(False) will be called explicitly when we're switching
      Host. To that end, SetURL always disconnects }
    if (FConnected) then
      Exit;

    { Proxy?? }
    if Length(FProxy) > 0 then
      AccessType := INTERNET_OPEN_TYPE_PROXY
    else
      AccessType := INTERNET_OPEN_TYPE_PRECONFIG;

    { Also, could switch to new API introduced in IE4/Preview2}
    if InternetAttemptConnect(0) <> ERROR_SUCCESS then
      SysUtils.Abort;

    FInetRoot := InternetOpen(PChar(FAgent), AccessType, PChar(FProxy), 
PChar(FProxyByPass), 0);
    Check(not Assigned(FInetRoot));
    try
      FInetConnect := InternetConnect(FInetRoot, PChar(FURLHost), FURLPort, 
PChar(FUserName),
        PChar(FPassword), INTERNET_SERVICE_HTTP, 0, Cardinal(Self));
      Check(not Assigned(FInetConnect));
      FConnected := True;
    except
      InternetCloseHandle(FInetRoot);
      FInetRoot := nil;
      raise;
    end;
  end
  else
  begin
    if Assigned(FInetConnect) then
      InternetCloseHandle(FInetConnect);
    FInetConnect := nil;
    if Assigned(FInetRoot) then
      InternetCloseHandle(FInetRoot);
    FInetRoot := nil;
    FConnected := False;
  end;
end;

procedure THTTPReqResp.Receive(Context: Integer; Resp: TStream; IsGet: 
Boolean);
var
  Size, Downloaded, Status, Len, Index: DWord;
  S: string;
{$IFDEF UNICODE}
  bytes: TBytes;
{$ENDIF}
begin
  Len := SizeOf(Status);
  Index := 0;

  { Handle error }
  if HttpQueryInfo(Pointer(Context), HTTP_QUERY_STATUS_CODE or 
HTTP_QUERY_FLAG_NUMBER,
    @Status, Len, Index) and (Status >= 300) and (Status <> 500) then
  begin
    Index := 0;
    Size := MaxStatusTest;
    SetLength(S, Size);
    if HttpQueryInfo(Pointer(Context), HTTP_QUERY_STATUS_TEXT, @S[1], Size, 
Index) then
    begin
      SetLength(S, Size div sizeof(Char));
      raise ESOAPHTTPException.CreateFmt('%s (%d) - ''%s''', [S, Status, 
FURL], Status);
    end;
  end;

  { Ask for Content-Type }
  Size := MaxContentType;
  SetLength(FContentType, MaxContentType);
  HttpQueryInfo(Pointer(Context), HTTP_QUERY_CONTENT_TYPE, @FContentType[1], 
Size, Index);
  SetLength(FContentType, Size div sizeof(Char));

  { Extract Mime-Boundary }
  FMimeBoundary := GetMimeBoundaryFromType(FContentType);

  { Read data }
  Len := 0;
  repeat
    Check(not InternetQueryDataAvailable(Pointer(Context), Size, 0, 0));
    if Size > 0 then
    begin
{$IFDEF UNICODE}
      SetLength(bytes, Size);
      Check(not InternetReadFile(Pointer(Context), bytes, Size, 
Downloaded));
      Resp.Write(bytes[0], Size);
{$ELSE}
      SetLength(S, Size);
      Check(not InternetReadFile(Pointer(Context), @S[1], Size, 
Downloaded));
      Resp.Write(S[1], Size);
{$ENDIF}

      { Receiving Data event }
      if Assigned(FOnReceivingData) then
        FOnReceivingData(Size, Downloaded)
    end;
  until Size = 0;

  { Check that we have a valid content type}
  { Ideally, we would always check but there are several WebServers out 
there
    that send files with .wsdl extension with the content type 'text/plain' 
or
    'text/html' ?? }
  if not IsGet then
    CheckContentType;
end;


function THTTPReqResp.HandleWinInetError(LastError: DWord; Request: 
HINTERNET): DWord;
begin
  Result := HandleWinInetErrorEx(LastError, Request, False);
end;

function THTTPReqRespHelper.HandleWinInetErrorEx(LastError: DWord;
                                                 Request: HINTERNET;
                                                 RaiseError: Boolean): 
DWord;

  function CallInternetErrorDlg: DWord;
  var
    P: Pointer;
  begin
    Result := InternetErrorDlg(GetDesktopWindow(), Request, LastError,
                               FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
                               FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
                               FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, P);

    { After selecting client certificate send request again,
      Note: InternetErrorDlg always returns ERROR_SUCCESS when called with
            ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED }
    if LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED then
      Result := ERROR_INTERNET_FORCE_RETRY;
  end;

const
  { Missing from our WinInet currently }
  INTERNET_OPTION_CLIENT_CERT_CONTEXT = 84;

var
  Flags, FlagsLen, DWCert, DWCertLen: DWord;
  ClientCertInfo: IClientCertInfo;
  CertSerialNum: string;
{$IFDEF CLIENT_CERTIFICATE_SUPPORT}
  hStore: HCERTSTORE;
  CertContext: PCERT_CONTEXT;
{$ENDIF}
begin
  { Dispatch to custom handler, if there's one }
  if Assigned(FOnWinInetError) then
    Result := FOnWinInetError(LastError, Request)
  else
  begin
    Result := ERROR_INTERNET_FORCE_RETRY;
    { Handle INVALID_CA discreetly }
    if (LastError = ERROR_INTERNET_INVALID_CA) and (soIgnoreInvalidCerts in 
InvokeOptions) then
    begin
      FlagsLen := SizeOf(Flags);
      InternetQueryOption(Request, INTERNET_OPTION_SECURITY_FLAGS, 
Pointer(@Flags), FlagsLen);
      Flags := Flags or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
      InternetSetOption(Request, INTERNET_OPTION_SECURITY_FLAGS, 
Pointer(@Flags), FlagsLen);
    end
{$IFDEF CLIENT_CERTIFICATE_SUPPORT}
    else if (LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED) and
             Supports(Self, IClientCertInfo, ClientCertInfo) and
             (ClientCertInfo.GetCertSerialNumber <> '') then
    begin
      CertSerialNum := ClientCertInfo.GetCertSerialNumber();
      hStore := ClientCertInfo.GetCertStore();
      if hStore = nil then
      begin
        hStore := CertOpenSystemStore(0, PChar('MY'));
        ClientCertInfo.SetCertStore(hStore);
      end;
      CertContext := FindCertWithSerialNumber(hStore, CertSerialNum);
      if CertContext <> nil then
      begin
        ClientCertInfo.SetCertContext(CertContext);
        InternetSetOption(Request, INTERNET_OPTION_CLIENT_CERT_CONTEXT,
                          CertContext, SizeOf(CERT_CONTEXT));
      end
      else
      begin
        if RaiseError then
          RaiseCheck(LastError);
        Result := CallInternetErrorDlg;
      end;
    end
{$ENDIF}
    else if (LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED) and 
(soPickFirstClientCertificate in InvokeOptions) then
    begin
      { This instructs WinInet to pick the first (a random?) client 
cerficated }
      DWCertLen := SizeOf(DWCert);
      DWCert := 0;
      InternetSetOption(Request, 
INTERNET_OPTION_SECURITY_SELECT_CLIENT_CERT,
                        Pointer(@DWCert), DWCertLen);
    end
    else
    begin
      if RaiseError then
        RaiseCheck(LastError);
      Result := CallInternetErrorDlg;
    end;
  end;
end;


function THTTPReqResp.Send(const ASrc: TStream): Integer;
const
  ContentTypeFormat: array[Boolean] of string = (ContentTypeTemplate, 
ContentTypeWithActionFmt);
var
  Request: HINTERNET;
  RetVal, Flags: DWord;
  ActionHeader: string;
  ContentHeader: string;
  BuffSize, Len: Integer;
  INBuffer: INTERNET_BUFFERS;
  WithAction: Boolean;
  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);

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

    end else { Assume btSOAP }
    begin
      { SOAPAction header }
      WithAction := not (soNoSOAPActionHeader in FInvokeOptions);
      {Content Type Header }
      if not (wnoSOAP12 in GetWebNodeOptions) then
      begin
        if not (soNoSOAPActionHeader in FInvokeOptions) then
        begin
          ActionHeader := GetSOAPActionHeader;
          HttpAddRequestHeaders(Request, PChar(ActionHeader), 
Length(ActionHeader), HTTP_ADDREQ_FLAG_ADD);
        end;

        if UseUTF8InHeader then
          ContentHeader := Format(ContentTypeTemplate, [ContentTypeUTF8])
        else
          ContentHeader := Format(ContentTypeTemplate, [ContentTypeNoUTF8]);
      end
      else
      begin
        if UseUTF8InHeader then
          ContentHeader := Format(ContentTypeFormat[WithAction], 
[ContentType12UTF8, GetSOAPAction])
        else
          ContentHeader := Format(ContentTypeFormat[WithAction], 
[ContentType12NoUTF8, GetSOAPAction]);
      end;
    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;

          { 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 := HandleWinInetErrorEx(GetLastError, Request, True);

              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 := HandleWinInetErrorEx(GetLastError, Request, True);

            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.public.inetsdk.programming.wininet/2006-08/00013/Re:_ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED_from_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 := HandleWinInetErrorEx(GetLastError, Request, True);

          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;

function THTTPReqResp.SendGet: Integer;
var
  Request: HINTERNET;
  RetVal, Flags : DWord;
  AcceptTypes: array of PChar;
begin
  { Connect }
  Connect(True);

  SetLength(AcceptTypes, 2);
  AcceptTypes[0] := PChar('*/*');  { Do not localize }
  AcceptTypes[1] := nil;
  Flags := INTERNET_FLAG_DONT_CACHE;
  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, 'GET', PChar(FURLSite), nil, 
{ Do not localize }
      nil, Pointer(AcceptTypes), Flags, Integer(Self));
    Check(not Assigned(Request), False);

    while True do
    begin
      if (not HttpSendRequest(Request, nil, 0, nil, 0)) then
      begin
        RetVal := HandleWinInetError(GetLastError(), Request);
        case RetVal of
          ERROR_CANCELLED: SysUtils.Abort;
          ERROR_SUCCESS: Break;
          ERROR_INTERNET_FORCE_RETRY: {Retry the operation};
        end;
      end
      else
        Break;
    end;
  except
    if (Request <> nil) then
      InternetCloseHandle(Request);
    Connect(False);
    raise;
  end;
  Result := Integer(Request);
end;
{$ENDIF}

{$IFDEF USE_INDY}
procedure THTTPReqResp.SetupIndy(IndyHttp: TIDHttp; Request: TStream);

  procedure GetHostAndPort(const AURL: string; var AHost, APort: string);
  var
    Index: Integer;
  begin
    Index := Pos(':', AURL);
    if Index > 0 then
    begin
      AHost := Copy(AURL, 1, Index-1);
      APort := Copy(AURL, Index+1, MaxInt);
    end;
end;

  function IsHTTPS: Boolean;
  var
    Protocol, Host, path, Document, Port, Bookmark: string;
  begin
    ParseURI(FUrl, Protocol, Host, path, Document, Port, Bookmark);
    Result := AnsiSameText(Protocol, 'HTTPS');
  end;

var
  Protocol, Host, Path, Document, Port, Bookmark: string;
begin
{$IFDEF INDY_CUSTOM_IOHANDLER}
  if FIOHandler <> nil then
    IndyHttp.IOHandler := FIOHandler
  else
{$ENDIF}
  begin
    if IsHttps then
    begin
{$IFDEF INDY_10}
      IndyHttp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
{$ELSE}
      IndyHttp.IOHandler := TIdSSLIOHandlerSocket.Create(nil);
{$ENDIF}
    end;
  end;

{  if Request is TMimeAttachmentHandler then }
  if FBindingType = btMIME then
  begin
    IndyHttp.Request.ContentType := Format(ContentHeaderMIME, 
[FMimeBoundary]);
    IndyHttp.Request.CustomHeaders.Add(MimeVersion);
  end else { Assume btSOAP }
  begin
    IndyHttp.Request.ContentType := sTextXML;
    IndyHttp.Request.CustomHeaders.Add(GetSOAPActionHeader);
  end;

  IndyHttp.Request.Accept := '*/*';
  IndyHttp.Request.UserAgent := Self.FAgent;

  { Proxy support configuration }
  if FProxy <> '' then
  begin
    { first check for 'http://localhost:####' }
    ParseURI(FProxy, Protocol, Host, Path, Document, Port, Bookmark);
    { if fail then check for 'localhost:####' }
    if Host = '' then
      GetHostAndPort(FProxy, Host, Port);
    IndyHttp.ProxyParams.ProxyServer := Host;
    if Port <> '' then
      IndyHttp.ProxyParams.ProxyPort := StrToInt(Port);

    { If name/password is used in conjunction with proxy, it's passed
      along for proxy authentication }
    IndyHttp.ProxyParams.ProxyUsername := FUserName;
    IndyHttp.ProxyParams.ProxyPassword := FPassword;
  end else
  begin
    { no proxy with Username/Password implies basic authentication }
    IndyHttp.Request.Username := FUserName;
    IndyHttp.Request.Password := FPassword;
  end;
{$IFNDEF INDY_10}
  IndyHttp.Host := FUrlHost;
  IndyHttp.Port := FUrlPort;
{$ENDIF}
end;
{$ENDIF}

procedure THTTPReqResp.Get(Resp: TStream);
{$IFNDEF USE_INDY}
var
  Context: Integer;
{$ENDIF}
{$IFDEF USE_INDY}
  procedure LoadFromURL(URL: string; Stream: TStream);
  var
    IndyHTTP: TIDHttp;
    Protocol, Host, Path, Document, Port, Bookmark: string;
  begin
    IndyHTTP := TIDHttp.Create(Nil);
    try
      IndyHttp.Request.Accept := '*/*';
      IndyHttp.Request.UserAgent := Self.FAgent;
      IndyHttp.Request.ContentType := sTextXml;
      if FProxy <> '' then
      begin
        ParseURI(FProxy, Protocol, Host, Path, Document, Port, Bookmark);
        IndyHttp.ProxyParams.ProxyServer := Host;
        IndyHttp.ProxyParams.ProxyPort := StrToInt(Port);
        IndyHttp.ProxyParams.ProxyUsername := FUserName;
        IndyHttp.ProxyParams.ProxyPassword := FPassword;
      end else
      begin
        { no proxy with Username/Password implies basic authentication }
        IndyHttp.Request.Username := FUserName;
        IndyHttp.Request.Password := FPassword;
      end;
      { IndyHttp.Intercept := FIntercept; }
      IndyHttp.Get(URL, Stream);
    finally
      IndyHTTP.Free;
    end;
  end;
{$ENDIF}
begin
  { GETs require a URL }
  if URL = '' then
    raise ESOAPHTTPException.Create(SEmptyURL);
{$IFDEF USE_INDY}
  { GET with INDY }
  LoadFromURL(URL, Resp);
{$ELSE}
  Context := SendGet;
  try
    Receive(Context, Resp, True);
  finally
    if Context <> 0  then
      InternetCloseHandle(Pointer(Context));
    Connect(False);
  end;
{$ENDIF}
end;

{ Here the RIO can perform any transports specific setup before call - XML 
serialization is done }
procedure THTTPReqResp.BeforeExecute(const IntfMD: TIntfMetaData;
                                     const MethMD: TIntfMethEntry;
                                     MethodIndex: Integer;
                                     AttachHandler: IMimeAttachmentHandler);
var
  MethName: InvString;
  Binding: InvString;
  QBinding: IQualifiedName;
  SOAPVersion: TSOAPVersion;
begin
  if FUserSetURL then
  begin
    MethName := InvRegistry.GetMethExternalName(IntfMD.Info, MethMD.Name);
    FSoapAction := InvRegistry.GetActionURIOfInfo(IntfMD.Info, MethName, 
MethodIndex);
  end
  else
  begin
    { User did *NOT* set a URL }
    if WSDLView <> nil then
    begin
      if ioSOAP12 in InvRegistry.GetIntfInvokeOptions(IntfMD.Info) then
        SOAPVersion := svSOAP12
      else
        SOAPVersion := svSOAP11;

      { Make sure WSDL is active }
      WSDLView.Activate;
      QBinding := WSDLView.WSDL.GetBindingForServicePort(WSDLView.Service, 
WSDLView.Port);
      if QBinding <> nil then
      begin
        Binding := QBinding.Name;
        MethName:= InvRegistry.GetMethExternalName(WSDLView.IntfInfo, 
WSDLView.Operation);

        FSoapAction := WSDLView.WSDL.GetSoapAction(Binding, MethName, 0, 
SOAPVersion);
      end;

      {NOTE: In case we can't get the SOAPAction - see if we have something 
in the registry }
      {      It can't hurt:) }
      if FSoapAction = '' then
        InvRegistry.GetActionURIOfInfo(IntfMD.Info, MethName, MethodIndex);

      { Retrieve URL }
      FURL := WSDLView.WSDL.GetSoapAddressForServicePort(WSDLView.Service, 
WSDLView.Port, SOAPVersion);
      if (FURL = '') then
        raise ESOAPHTTPException.CreateFmt(sCantGetURL,
                                           [WSDLView.Service, WSDLView.Port, 
WSDLView.WSDL.FileName]);
      InitURL(FURL);
    end
    else
      raise ESOAPHTTPException.Create(sNoWSDLURL);
  end;

  { Are we sending attachments?? }
  if AttachHandler <> nil then
  begin
    FBindingType := btMIME;
    { If yes, ask MIME handler what MIME boundary it's using to build the 
Multipart
      packet }
    FMimeBoundary := AttachHandler.MIMEBoundary;

    { Also customize the MIME packet for transport specific items }
    if UseUTF8InHeader then
      AttachHandler.AddSoapHeader(Format(ContentTypeTemplate, 
[ContentTypeUTF8]))
    else
      AttachHandler.AddSoapHeader(Format(ContentTypeTemplate, 
[ContentTypeNoUTF8]));
    AttachHandler.AddSoapHeader(GetSOAPActionHeader);
  end else
    FBindingType := btSOAP;
end;

procedure THTTPReqResp.Execute(const DataMsg: String; Resp: TStream);
var
  Stream: TMemoryStream;
{$IFDEF UNICODE}
  AStr: AnsiString;
{$ENDIF}
begin
{$IFDEF UNICODE}
  AStr := UTF8Encode(DataMsg);
{$ENDIF}
  Stream := TMemoryStream.Create;
  try
{$IFDEF UNICODE}
    Stream.SetSize(Length(AStr));
    Stream.Write(AStr[1], Length(AStr));
{$ELSE}
    Stream.SetSize(Length(DataMsg));
    Stream.Write(DataMsg[1], Length(DataMsg));
{$ENDIF}
    Execute(Stream, Resp);
  finally
    Stream.Free;
  end;
end;

function THTTPReqResp.Execute(const Request: TStream): TStream;
begin
  Result := TMemoryStream.Create;
  Execute(Request, Result);
end;

procedure THTTPReqResp.CheckContentType;
begin
  { NOTE: Content-Types are case insensitive! }
  {       Here we're not validating that we
          have a valid content-type; rather
          we're checking for some common invalid
          ones }
  if SameText(FContentType, ContentTypeTextPlain) or
     SameText(FContentType, STextHtml) then
    raise ESOAPHTTPException.CreateFmt(SInvalidContentType, [FContentType]);
end;

procedure THTTPReqResp.Execute(const Request: TStream; Response: TStream);

  function IsErrorStatusCode(Code: Integer): Boolean;
  begin
    case Code of
      404, 405, 410:
        Result := True;
      else
        Result := False;
    end;
  end;

{$IFDEF USE_INDY}
  procedure PostData(const Request: TStream; Response: TStream);
  var
    IndyHTTP: TIDHttp;
  begin
    IndyHTTP := TIDHttp.Create(Nil);
    try
      SetupIndy(IndyHTTP, Request);
      IndyHttp.Post(FURL, Request, Response);
      FContentType := IndyHttp.Response.RawHeaders.Values[SContentType];
      FMimeBoundary := GetMimeBoundaryFromType(FContentType);
      if Response.Size = 0 then
        raise ESOAPHTTPException.Create(SInvalidHTTPResponse);
      CheckContentType;
    finally
      if Assigned(IndyHttp.IOHandler) then
{$IFDEF INDY_CUSTOM_IOHANDLER}
        { Don't free the IOHandler if we did not create it }
        if FIOHandler = nil then
{$ENDIF}
        IndyHttp.IOHandler.Free;
      FreeAndNil(IndyHTTP);
    end;
  end;


{$ELSE}
var
  Context: Integer;
  CanRetry: Boolean;
  LookUpUDDI: Boolean;
  AccessPoint: String;
  PrevError: String;
{$ENDIF}
begin
{$IFNDEF USE_INDY}
  LookUpUDDI := False;
  CanRetry := (soAutoCheckAccessPointViaUDDI in FInvokeOptions) and
              (Length(FUDDIBindingKey) > 0) and
              (Length(FUDDIOperator) > 0);
{$ENDIF}
{$IFDEF USE_INDY}
  PostData(Request, Response);
{$ELSE}
  while (True) do
  begin
    { Look up URL from UDDI?? }
    if LookUpUDDI and CanRetry then
    begin
      try
        CanRetry := False;
        AccessPoint := '';
        AccessPoint := GetBindingkeyAccessPoint(FUDDIOperator, 
FUDDIBindingKey);
      except
        { Ignore UDDI lookup error }
      end;
      { If UDDI lookup failed or we got back the same URL we used...
        raise the previous execption message }
      if (AccessPoint = '') or SameText(AccessPoint, FURL) then
        raise ESOAPHTTPException.Create(PrevError);
      SetURL(AccessPoint);
    end;

    Context := Send(Request);
    try
      try
        Receive(Context, Response);
        Exit;
      except
        on Ex: ESOAPHTTPException do
        begin
          Connect(False);
          if not CanRetry or not IsErrorStatusCode(Ex.StatusCode) then
            raise;
          { Trigger UDDI Lookup }
          LookUpUDDI := True;
          PrevError := Ex.Message;
        end;
        else
        begin
          Connect(False);
          raise;
        end;
      end;
    finally
      if Context <> 0  then
        InternetCloseHandle(Pointer(Context));
    end;
  end;
{$ENDIF}
end;

{$IFDEF DEXTER_UP}
function THTTPReqResp.GetAgentIsStored: Boolean;
begin
  Result := FAgent <> SOAP_AGENT;
end;
{$ENDIF}


end.
{code}
0
Jean
5/23/2011 11:43:39 PM
Zipped up version posted here: 
https://forums.embarcadero.com/thread.jspa?messageID=355655&tstart=0#355655

Cheers,

Bruneau
0
Jean
5/23/2011 11:47:21 PM
Thank you, very much !
René
> {quote:title=Jean-Marie Babet wrote:}{quote}
> Zipped up version posted here: 
> https://forums.embarcadero.com/thread.jspa?messageID=355655&tstart=0#355655
> 
> Cheers,
> 
> Bruneau
0
Rene
5/24/2011 1:25:12 PM
I hope you still read this thread.
My problem seems more complicated.
My client app, makes a request to a web server (third party), to save some information I send in my request. In response the web service should response with some XML Tags saying that the info has been saved successfully, plus a PDF file in Base64 (in another XML tag of the same response).

Now, the problem is that the webservice DOES save the info I am sending, but DOES NOT reply with the response containing the OK plus the PDF in base64. And my application raises this error: "The handle is in the wrong state..."

This way my app. users believe that the info was not saved, and they try to save the info again and again... and on the webserver the same info gets saved 5-10 times and my app does not receive the required confirmation.

I suspect the server to be overwhelmed by too many requests, and probably it takes too long for it to respond, this way my client app has no patience and throws the handle error.

What should I do?
I do not have access to the webservice server, and I cannot ask them to change anything on the server side. All I can do is do something in my client app.
But what should I do?
Catching the WinInetError does not solve my problem since the info gets saved on the server, so even if I raise an error that is more intelligible ... that does not help me since the info was already saved and I did not receive the expected result/response.
I also cannot check if the info is already saved so I can request to get the response later... it's a mess.

Please let me know if there is anything I can do.

I placed this in onBeforeExecute of the HTTPRIO I use
  HTTPRIO1.HTTPWebNode.ConnectTimeout:=120000;
  HTTPRIO1.HTTPWebNode.ReceiveTimeout:=120000;
  HTTPRIO1.HTTPWebNode.SendTimeout:=120000;

but the result is the same.
Should I just increase these values?
Would that be of any use?


PS: My client app conects to the webservice through a SOAP proxy app of my own. And the above timeouts are located on the proxy side.
I have to do this because the server requires that all requests should be made from the same IP address, so I had to implement this proxy server. Also this worked just fine until a couple of weeks ago. And I also have other proxy servers built the same way for other web services that work like a charm... except for this one


Please help. Is there anything more I can do to make this problem go away?







> {quote:title=Jean-Marie Babet wrote:}{quote}
> Zipped up version posted here: 
> https://forums.embarcadero.com/thread.jspa?messageID=355655&tstart=0#355655
> 
> Cheers,
> 
> Bruneau
0
Softwarex
7/4/2011 5:28:41 PM
Hello,

A bug was introduced sometime in 2010 that would result in the SOAP's 
WinInet wrapper failing to detect certain error conditions. The runtime 
would think everything is fine... and on the next call to WinInet, the 
latter would report "The handle is in the wrong state for the requested 
operation". After I noticed a few posts about this error, I researched this 
issue and reverted that regression. I've posted an update here: 
https://forums.embarcadero.com/thread.jspa?messageID=351958

Your post also brings up the greater issue of idempotency. This is a much 
studied area and there are many recommendations/techniques that deal with it 
(mainly in the context of guarding against message replays - but that's 
irrelevant in this case). But it sounds that in your case the Server does 
not expose an idempotent operation :(

> Now, the problem is that the webservice DOES save the info I am sending, 
> but DOES NOT reply with the
> response containing the OK plus the PDF in base64. And my application 
> raises
> this error: "The handle is in the wrong state..."
>

What does the Server respond with? It would be helpful to monitor the 
traffic between the Server and the proxy here. IOW, does the Service handle 
the request and sends nothing back? The "Handle is in the wrong state" is an 
internal WinInet error: IOW, it's not a relay of something the Server sent 
back; so understand whether the Server sent anything, and if yes, what?, 
would be helpful in this scenario.

Cheers,

Bruneau
0
Jean
7/5/2011 6:42:47 PM
For the moment, the increase in the timeout values solved my problem. So the error message does not show anymore and the operations work as they should... for now...
At the moment I am afraid to make radical changes in my code because being a production version of the application, a lot of my clients are using it daily and I cannot afford to block them... Of course I could make a branch out of it, but right now I have too many things to do in the app so I cannot focus on that many issues at once.
I will return here with more info if the problem re-appears.
I'm sorry for bothering you and then leaving your questions unanswered.
However I am sure that the problem will resurface pretty soon, and then I will be forced to deal with it.

Thank you again so far, and I will let this question open for that moment.
Have a nice day


> {quote:title=Jean-Marie Babet wrote:}{quote}
> Hello,
> 
> A bug was introduced sometime in 2010 that would result in the SOAP's 
> WinInet wrapper failing to detect certain error conditions. The runtime 
> would think everything is fine... and on the next call to WinInet, the 
> latter would report "The handle is in the wrong state for the requested 
> operation". After I noticed a few posts about this error, I researched this 
> issue and reverted that regression. I've posted an update here: 
> https://forums.embarcadero.com/thread.jspa?messageID=351958
> 
> Your post also brings up the greater issue of idempotency. This is a much 
> studied area and there are many recommendations/techniques that deal with it 
> (mainly in the context of guarding against message replays - but that's 
> irrelevant in this case). But it sounds that in your case the Server does 
> not expose an idempotent operation :(
> 
> > Now, the problem is that the webservice DOES save the info I am sending, 
> > but DOES NOT reply with the
> > response containing the OK plus the PDF in base64. And my application 
> > raises
> > this error: "The handle is in the wrong state..."
> >
> 
> What does the Server respond with? It would be helpful to monitor the 
> traffic between the Server and the proxy here. IOW, does the Service handle 
> the request and sends nothing back? The "Handle is in the wrong state" is an 
> internal WinInet error: IOW, it's not a relay of something the Server sent 
> back; so understand whether the Server sent anything, and if yes, what?, 
> would be helpful in this scenario.
> 
> Cheers,
> 
> Bruneau
0
Softwarex
7/6/2011 12:45:44 AM
Hi,

I asked this question on the Attatchments forum, and then realised that was probably not the best place.  I would be grateful if someone could tell me how to go about installing the updated SOAPHTTPTrans code.  I've tried adding the new SOAPHTTPTrans.pas source to my project , but when I compile I get "E2200 Package 'soaprtl' already contains unit 'SOAPHTTPTrans'". Removing soaprtl results in further errors. Can anyone help with this?

Thanks,
Simon
0
Simon
4/17/2012 7:42:18 AM
Reply: