0

我在 Delphi XE 中创建了一个 SOAPServerwithINDYVCL。当客户端由于客户端超时或网络连接断开等任何原因与服务器断开连接时。我在服务器端收到错误，因为 Socket Error 10053 - 软件导致连接中止。

弹出此错误并阻止我的服务器线程。

我还用 SOAPDMServerIndy 的演示检查了这一点。在这里，如果我启动服务器，连接客户端并且在服务器响应之前断开客户端，我会收到套接字错误。

任何人都知道如何处理这个异常？

4

1 回答 1

0

即使在这个时候，这个问题仍然存在。这是因为这段代码：

procedure TWebRequestHandler.HandleException(Sender: TObject);
var
  Handled: Boolean;
  Intf: IWebExceptionHandler;
begin
  Handled := False;
  if ExceptObject is Exception and
    Supports(Sender, IWebExceptionHandler, Intf) then
    try
      Intf.HandleException(Exception(ExceptObject), Handled);
    except
      Handled := True;
      System.SysUtils.ShowException(ExceptObject, ExceptAddr);
    end;
  if (not Handled) then
    System.SysUtils.ShowException(ExceptObject, ExceptAddr);
end;

该行Intf.HandleException(Exception(ExceptObject), Handled)调用 TCustomWebDispatcher.HandleException 过程。此过程检查应用程序的 TWebModule 后代中是否存在 OnException 事件处理程序。如果它存在（我会推荐它），则调用事件处理程序过程，并将 var 参数 'Handled' 设置为 true。

procedure TCustomWebDispatcher.HandleException(E: Exception; var Handled: Boolean);
begin
  Handled := False;
  if Assigned(FOnException) then
  begin
    Handled := True;
    if Response <> nil then
      Response.StatusCode := 500; { Allow the user to override the StatusCode }
    FOnException(Self, E, Handled);
    if Handled and (Response <> nil) then
      Response.SendResponse;
  end;
  if not Handled then
    if Response <> nil then
    begin
      Response.Content := Format(sInternalApplicationError, [E.Message, Request.PathInfo]);
      if not Response.Sent then
      begin
        Response.StatusCode := 500;
        Response.SendResponse;
      end;
      Handled := True;
    end;
end;

当处理程序返回时，有两种情况：

  1. 处理为真；将发送导致新异常的响应。这将被传播回调用代码（第一个块中的过程），因此将调用 ShowException。

  2. 处理为假；Response <> nil将评估为 True 所以什么时候Response.Sent是 False 会发生同样的事情。

我通过尝试从 OnException 事件处理程序发送响应解决了这个问题。当它失败时会引发异常。在这种情况下，我将 TWebModule 后代的只读属性“Response”的字段“FResponse”设置为“nil”。但是，这个字段是一个私有字段，所以我使用了一些 rtti 来访问它。

procedure TwbmWebBrokerServerModule.UnlinkResponseObject;
begin
  inherited;

  TRTTIContext.Create.GetType(ClassInfo).GetField('FResponse').SetValue(Self, TValue.From(nil));
end;

procedure TwbmWebBrokerServerModule.WebModuleException(Sender: TObject; E: Exception; var Handled: Boolean);
begin
  uVMI_Tools.AppendToLog(E.Message + ' (' + Request.PathInfo + ')');

  if Request.Accept.Contains(CONTENTTYPE_APPLICATION_JSON) then
  begin
    Response.Content := StringToJSON(E.Message);
    Response.ContentType := CONTENTTYPE_APPLICATION_JSON;
  end
  else
    Response.Content := E.Message;

  try
    Response.SendResponse;
  except
    UnlinkResponseObject;
  end;
end;

因此，当发送响应时发生异常时，属性“响应”设置为 nil，因此不会尝试再次发送响应。

不需要销毁响应对象，将 nil 分配给它就足够了。这是因为 Response 对象是在 TIdCustomHTTPServer 类中创建的，该类刚刚将其传递给 TWebModule 后代。（其实是TWebModule的父类TCustomWebDispatcher）

于 2019-08-14T13:21:00.063 回答