Question

我在visual studio中构建了世界上最愚蠢，最简单的SOAP服务器，大约3次点击。 Visual Studio 2010中的确切步骤：首先将新项目创建为Web应用程序，然后添加Web服务类型的新项目。（有关图片，请参阅已接受的答案here。）肥皂服务器服务Service1有一个简单的方法GetData：

来自clientService1.pas的片段，使用WSDL导入程序创建...

  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

有一段时间，在Embarcadero论坛上，Embarcadero职员队员Bruneau Babet从Embarcadero论坛中删除了对话中的错误。

布鲁诺说：

您好，

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

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

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

干杯，

布诺

您可以通过以下pastebin link和bitbucket以原始论坛格式获取修复及其相关说明，因此您无需从周围文本中提取文件。

Warren 2016更新：有人试图在Delphi XE上使用此修补程序，我发现此修复程序在Delphi XE中不适用于我们。任何进一步更新bitbucket中的代码，以解决剩余的错误将不胜感激。

Answer 2

我在2018年11月使用Delphi Tokyo 10.2.3遇到句柄处于所请求操作的错误状态，然后在the pastebin link中的{ {3}}。

该代码很旧，测试代码不再起作用（SOAP服务不可用）。另外，从布鲁诺的代码他确切修补过的内容还不清楚。

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

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 过程参数；-）

以下是使用NOAA的Arjen's answer的SOAP服务进行的一些测试代码：

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质量门户网站中报告了该问题，编号为National Digital Forecast Database (NDFD) SOAP Web Service

使用后果自负，请报告所有其他发现。

添加：此问题已于2018年12月在Delphi 10.3 Rio中修复，质量门户问题已关闭，并带有以下说明：

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

我尚未验证。

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

2 个答案: