当在不同的线程中使用时，超字节超时

Question

我一直在试图找出这个错误我们大约4天了。我使用Delphi XE并创建了一个小工具供翻译人员使用。我有了使用微软翻译API的想法，以帮助使事情变得更容易，少一点繁琐。

我创建了一个访问Microsoft translator 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的部分设计需要一个接收事件消息的窗口，为此，在这里使用RegisterClass注册一个控制类，在这里使用CreateWindowEx创建一个实例，两者都在调用THttpCli.Create中。

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

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

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

附录

呼叫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;