在不同线程中使用时 OverbyteICS HTTP 超时

Question

我已经尝试找出这个错误大约四天了。我正在使用 Delphi XE，并创建了一个小工具供翻译人员使用。我想到了使用 Microsoft Translation API 来帮助让事情变得更轻松并且不那么乏味。

我创建了一个访问 Microsoft 翻译器 API 的类，但我想使其成为线程安全的，以便可以在后台发出请求。我发送获取访问令牌的请求没有问题，但是，我在单独的线程中运行该请求。当用户单击按钮时，我会生成一个新线程并运行 http 请求来翻译其中的术语。然而，它每次都会超时。如果我从同一个线程运行它就没有问题。

这是我用于发送http请求的方法（传递的THttpCli对象在线程之间共享）

function sendHTTPRequest(APost: Boolean; AURI: UTF8string;
  AContentType: UTF8string; APostData: UTF8String; AHttpCli: TSSLHttpCli): UTF8string;
var
  DataOut: TMemoryStream;
  DataIn: TMemoryStream;
  lHTMLStream: TStringStream;
  lencoding: TUTF8Encoding;
  lownClient: boolean;
begin

  lownClient := false;
  if AHttpCli = nil then
  begin
    AHttpCli := TSSLHttpCli.Create(nil);
    AHttpCli.SslContext := TSSLContext.Create(nil);
    with AHttpCli.SslContext do
    begin
      SSLCipherList := 'ALL:!ADH:RC4+RSA:+SSLv2:@STRENGTH';
      SSLVersionMethod := sslV23_CLIENT;
      SSLVerifyPeerModes := [SslVerifyMode_PEER]
    end;
    AHttpCli.MultiThreaded := true;
    lownClient := true;
  end;

  AHttpCli.Accept := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';

  if APost then
  begin
    DataOut := TMemoryStream.Create;
    DataOut.Write(APostData[1], Length(APostData));
    DataOut.Seek(0, soFromBeginning);
  end;

  AHttpCli.URL := AURI;
  AHttpCli.ContentTypePost := AContentType;
  DataIn := TMemoryStream.Create;
  if APost then AHttpCli.SendStream := DataOut;
  AHttpCli.RcvdStream := DataIn;

  try
    if apost then
      AHttpCli.Post
    else
      AHttpCli.Get;

    lHTMLStream := TStringStream.Create('', TEncoding.UTF8);
    lHtmlStream.LoadFromStream(AHttpCli.RcvdStream);
    result := lHtmlStream.DataString;
    lHtmlStream.Free;

  finally
    AHttpCli.Close;
    AHttpCli.RcvdStream := nil;
    AHttpCli.SendStream := nil;
    DataIn.Free;

    if APost then
      DataOut.Free;

    if lownClient then
      AHttpCli.free;
  end;
end;

我认为显而易见的解决方案是只有一个线程等待信号执行，但我希望得到关于为什么会发生超时的解释。我无法解释为什么第二个线程超时而第一个线程没有超时。

HTTP 组件似乎卡在 dnslookup 上。OverbyteICS 使用 Windows 函数WSAAsyncGetHostByName来查找名称。

任何帮助深表感谢

2013 年 5 月 13 日更新：

因此，事实证明，THttpCli在线程之间共享对象似乎是导致超时的原因。解决方案只是将参数传递nil到AHttpCli我上面的函数中。

我仍然会接受关于为什么这会导致超时的答案。据我所知，该WSAAsyncGetHostByName方法不使用任何同步对象，并且另一个线程没有同时运行，因此不应该有任何东西阻塞线程。

Answer 1

在 Windows 上，OverbyteICS 使用WSAAsyncSelect（此处）和MsgWaitForMultipleObjects（此处）来允许套接字事件（FD_READ、FD_WRITE和FD_CLOSE）的异步通知FD_CONNECT。的部分设计WSAAsyncSelect需要一个将接收事件消息的窗口，为此，使用here注册一个控件类，并使用here创建一个实例，两者都在调用中。RegisterClass CreateWindowEx THttpCli.Create

这就是问题出现的地方；GetMessage正如和PeekMessage的文档中提到的PostMessage，消息队列本身是每个线程的。

我已经测试了在 2 个线程之间共享的进程的每个离散步骤（如下所列）的各种排列，唯一失败的组合是在不同线程上执行调用 和 时CreateWindowEx，MsgWaitForMultipleObjects这强化了这样的想法：给定的消息队列可以只能在同一个线程上访问。

看起来，无需重写 OverbyteICS 库本身，在线程环境中使用它的唯一方法是在与后续请求调用（等）THttpCli相同的线程中创建实例。THttpCli.GetTHttpCli.Post

附录

• 拨电至RegisterClass

procedure Up0(S: PState);
var
  WndClass: TWndClass;
begin
  FillChar(WndClass, SizeOf(TWndClass), 0);
  WndClass.lpfnWndProc := @DefWindowProc;
  WndClass.hInstance := hInstance;
  WndClass.lpszClassName := 'test';
  if RegisterClass(WndClass) = 0 then
    ExitProcess(GetLastError);
end;

• 拨电至CreateWindowEx

procedure Up1(S: PState);
begin
  S.Window := CreateWindowEx(WS_EX_TOOLWINDOW, 'test', '', WS_POPUP, 0, 0, 0, 0, 0, 0, hInstance, nil);
  if S.Window = 0 then
    ExitProcess(GetLastError);
end;

• 拨电至Ics_socket

procedure Up2(S: PState);
begin
  S.Socket := Ics_socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if S.Socket = INVALID_SOCKET then
    ExitProcess(Ics_WSAGetLastError);
end;

• 拨电至Ics_WSAAsyncSelect

procedure Up3(S: PState);
begin
  if Ics_WSAAsyncSelect(S.Socket, S.Window, WM_USER, FD_CONNECT) = SOCKET_ERROR then
    ExitProcess(Ics_WSAGetLastError);
end;

• 拨电至Ics_connect

procedure Up4(S: PState);
var
  Error: Integer;
  Sin: TSockAddrIn;
begin
  FillChar(Sin, SizeOf(TSockAddrIn), 0);
  Sin.sin_family := AF_INET;
  Sin.sin_port := Ics_htons(42);
  if Ics_connect(S.Socket, PSockAddr(@Sin)^, SizeOf(TSockAddrIn)) = SOCKET_ERROR then
  begin
    Error := Ics_WSAGetLastError;
    if Error <> WSAEWOULDBLOCK then
      ExitProcess(Error);
  end;
end;

• 拨电至MsgWaitForMultipleObjects

procedure Up5(S: PState);
var
  Msg: TMsg;
  WaitResult: Cardinal;
begin
  WaitResult := MsgWaitForMultipleObjects(0, Pointer(nil)^, False, 1000, QS_ALLINPUT);
  if WaitResult = WAIT_TIMEOUT then
  begin
    S.Result := 0;
    Exit;
  end;

  while PeekMessage(Msg, S.Window, WM_USER, WM_USER, PM_REMOVE) do
    if LOWORD(Msg.lParam) = FD_CONNECT then
    begin
      S.Result := 1;
      Exit;
    end;
end;