6

大约 4 天以来，我一直试图找出这个错误。我正在使用 Delphi XE，并创建了一个供翻译人员使用的小工具。我想到了使用 Microsoft 翻译 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方法不使用任何同步对象，并且另一个线程没有同时运行，所以不应该有任何阻塞线程的东西。

4

1 回答 1

1

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

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

我已经测试了在 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;

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;

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;
于 2021-08-26T07:41:57.153 回答