Delphi 中的 SOAP 客户端“句柄对于所请求的操作处于错误状态”

Question

我在 Visual Studio 中只需单击 3 次，就构建了世界上最愚蠢、最简单的 SOAP 服务器。 Visual Studio 2010 中的具体步骤： 首先创建一个新项目作为 Web 应用程序，然后添加一个类型为 Web 服务的新项目。 （参见接受的答案此处 查看图片。）soap 服务器服务 Service1 有一个简单的方法 GetData：

来自 clientService1.pas 的片段，使用 WSDL 创建importer...

  IService1 = interface(IInvokable)
  ['{967498E8-4F67-AAA5-A38F-F74D8C7E346A}']
    function  GetData(const value: Integer): string; stdcall;
    function  GetDataUsingDataContract(const composite: CompositeType2): CompositeType2; stdcall;
  end;

当我尝试运行此方法时，如下所示：

procedure TForm3.Button1Click(Sender: TObject);
var
 rio : THTTPRIO;
 sv:IService1;
 addr : string;
 data : string;
begin
    //addr := '....'; // url from visual studio 2010 live debug instance.
    rio := THTTPRIO.Create(nil);
    sv := GetIService1( true, addr, rio );
    try
        data := sv.GetData(  0);

        Button1.Caption := data;

    finally
        sv := nil;

        rio.Free;
    end;
 end;

我得到的错误是这样的：

ESOAPHTTPException: 
 The handle is in the wrong state for the requested operation -    
 URL:http://localhost:8732/Design_Time_Addresses/WcfServiceLibrary1/Service1/ -      
 SOAPAction:http://tempuri.org/IService1/GetData'.

当我将上面的 url 粘贴到 Web 浏览器中时，URL 工作正常，因此通常的答案是 Delphi 中的 SOAP 代码有这样的趋势不注意到 HTTP 故障似乎不太可能。相反，我似乎要么 (a) 在 WinInet 中遇到损坏（已知在某些版本的 Windows 中发生），要么 (b) 做错了什么？

在我看来，任何同时安装了 Visual Studio 和 Delphi 的人都应该能够尝试让 Visual Studio 中的虚拟启动 Soap 服务器与 Delphi 中的 Soap 客户端进行通信，而无需任何努力。但我无法弄清楚最简单的事情。

Answer 1

有一次，内河码头工作人员布鲁诺·巴贝特 (Bruneau Babet) 就一段对话中的错误进行了讨论，该对话现已从内河码头论坛中删除。

布鲁诺说：

你好，

我发布了 SOAPHTTPTrans.pas 的修补版本，其中包含修复程序
对于这个问题在这里：

[论坛链接已编辑，无论如何它不再起作用，帖子消失了]

您仍然可以按照 C++Builder 中的描述覆盖该事件
所提及的部分；或者，更简单，至少对于 Delphi 用户来说，简单地
将更新后的 SOAPHTTPTrans.pas 添加到您的应用程序的项目中。让我们知道
如果这对你不起作用。

干杯，

布鲁诺

您可以从以下 pastebin 链接 获取修复及其原始论坛格式的注释bitbucket 因此您不必提取文件从周围的文字。

Warren 更新 2016： 有人试图在 Delphi XE 上使用此修复程序，但我已被告知此修复程序在 Delphi XE 中对他们不起作用。如果对 bitbucket 中的代码进行任何进一步更新以解决剩余的错误，我们将不胜感激。

Answer 2

我在 2018 年 11 月使用 Delphi Tokyo 10.2.3 遇到了 The handle is in the error state for the requested operation 问题，然后查看了 href="https://stackoverflow.com/a/8195082/512728">Arjen 的回答。

该代码非常旧，测试代码不再有效（SOAP 服务不可用）。此外，从 Bruneau 的代码中还不清楚他到底修补了什么。

比较该源代码和我的 Delphi 版本中的源代码，似乎这些是 HandleWinInetError 过程中所需的（两个）修改（“PATCH HERE”）：

function THTTPReqResp.HandleWinInetError(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
    else if (LastError = ERROR_INTERNET_SEC_CERT_REV_FAILED) and (soIgnoreInvalidCerts in InvokeOptions) then
    begin
      FlagsLen := SizeOf(Flags);
      InternetQueryOption(Request, INTERNET_OPTION_SECURITY_FLAGS, Pointer(@Flags), FlagsLen);
      Flags := Flags or SECURITY_FLAG_IGNORE_REVOCATION;
      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);  // PATCH HERE
        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 cerficate }
      DWCertLen := SizeOf(DWCert);
      DWCert := 0;
      InternetSetOption(Request, INTERNET_OPTION_SECURITY_SELECT_CLIENT_CERT,
                        Pointer(@DWCert), DWCertLen);
    end
    else
    begin
      if RaiseError then RaiseCheck(LastError);  // PATCH HERE
      Result := CallInternetErrorDlg;
    end;
  end;
end;

请注意，RaiseError在此补丁之前甚至没有使用 procedure 参数；-)

这是一些使用 NOAA 的 SOAP 服务的测试代码 国家数字预报数据库 (NDFD) SOAP Web 服务：

Uses SOAP.SOAPHTTPTrans;

const Request2 =
'<soapenv:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:ndf="http://graphical.weather.gov/xml/DWMLgen/wsdl/ndfdXML.wsdl">' +
'   <soapenv:Header/>' +
'   <soapenv:Body>' +
'      <ndf:NDFDgenByDay soapenv:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +
'         <latitude xsi:type="xsd:decimal">38.9936</latitude>' +
'         <longitude xsi:type="xsd:decimal">-77.0224</longitude>' +
'         <startDate xsi:type="xsd:date">%tomorrow%</startDate>' +
'         <numDays xsi:type="xsd:integer">5</numDays>' +
'         <Unit xsi:type="dwml:unitType" xmlns:dwml="http://graphical.weather.gov/xml/DWMLgen/schema/DWML.xsd">e</Unit>' +
'         <format xsi:type="dwml:formatType" xmlns:dwml="http://graphical.weather.gov/xml/DWMLgen/schema/DWML.xsd">12 hourly</format>' +
'      </ndf:NDFDgenByDay>' +
'   </soapenv:Body>' +
'</soapenv:Envelope>';

const URL2= 'https://graphical.weather.gov:443/xml/SOAP_server/ndfdXMLserver.php';

procedure TFrmHandleWinINetError.Button1Click(Sender: TObject);
var
  RR: THTTPReqResp;
  Response: TMemoryStream;
  U8: UTF8String;
begin
  RR := THTTPReqResp.Create(nil);
  try
    try
      RR.URL := URL2;
      RR.UseUTF8InHeader := True;
      RR.SoapAction := 'NDFDgenByDay';
      Response := TMemoryStream.Create;
      RR.Execute(Request2, Response);
      SetLength(U8, Response.Size);
      Response.Position := 0;
      Response.Read(U8[1], Length(U8));
      ShowMessage(String(U8));
      except
        on E:Exception do ShowMessage('ERROR CAUGHT: ' + e.message);
      end;
    finally
      Response.Free;
      RR.Free;
    end;
  end;
end;  

没有 URL 尾部的补丁错误会被捕获，但域名中的错误只会触发空错误消息。
补丁也可以捕获这些内容。

我已在 RAD Studio 质量门户中报告了该问题，编号为 RSP-21862

使用您需自行承担风险，并请报告任何其他发现。

---

补充：该问题已于 2018 年 12 月在 Delphi 10.3 Rio 中得到修复，质量门户问题已结束，并附有以下评论：

在 RAD Studio 10.3 中，THTTPReqResp 的实现已更改并替换为 THTTPClient。因此，这个问题不再适用。

我还没有验证这一点。