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

Question

我一直试图找出这个错误我们大约 4 天了。我正在使用 Delphi XE 并创建了一个供翻译人员使用的小工具。我想到了使用 Microsoft Translation API 来帮助简化工作并减少乏味。

我创建了一个访问 Microsoft 转换器 API 的类，但我想让它成为线程安全的，以便可以在后台发出请求。我发送获取访问 token 的请求没有问题，但是，我在单独的线程中运行该请求。当用户单击按钮时，我会生成一个新线程并运行 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 ( here ) 和 MsgWaitForMultipleObjects ( here )允许异步通知套接字事件( FD_READ 、 FD_WRITE 、 FD_CLOSE 和 FD_CONNECT )。部分设计WSAAsyncSelect需要一个接收事件消息的窗口，为此，使用 RegisterClass 注册一个控件类。 here ，以及使用 CreateWindowEx 创建的实例here , 都在拨打 THttpCli.Create .
这就是问题出现的地方；正如 GetMessage 的文档中所提到的, PeekMessage 和 PostMessage ，消息队列本身是每个线程的。
我已经测试了在 2 个线程之间共享的进程(如下所列)的每个离散步骤的各种排列，唯一失败的组合是在调用 CreateWindowEx 时和 MsgWaitForMultipleObjects在不同的线程上执行，这强化了给定消息队列只能在同一线程上访问的想法。
看起来，无需重写 OverbyteICS 库本身，在线程环境中使用它的唯一方法就是创建 THttpCli 与后续请求调用( THttpCli.Get 、 THttpCli.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;