使用AsyncCalls单元创建线程池是否可行？

Question

我正在尝试使用AsyncCalls在整个C类子网上执行Netbios查找。理想情况下，我希望它可以同时执行10个以上的查找，但它目前只能一次执行一个查找。我在这里做错了什么？

我的表单包含1个按钮和1个备忘录。

unit main;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Forms,
  StdCtrls,
  AsyncCalls,
  IdGlobal,
  IdUDPClient,
  Controls;

type
  PWMUCommand = ^TWMUCommand;

  TWMUCommand = record
    host: string;
    ip: string;
    bOnline: boolean;
  end;

type
  PNetbiosTask = ^TNetbiosTask;

  TNetbiosTask = record
    hMainForm: THandle;
    sAddress: string;
    sHostname: string;
    bOnline: boolean;
    iTimeout: Integer;
  end;

const
  WM_THRD_SITE_MSG  = WM_USER + 5;
  WM_POSTED_MSG     = WM_USER + 8;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    procedure ThreadMessage(var Msg: TMessage); message WM_POSTED_MSG;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2             : TForm2;

implementation

{$R *.dfm}

function NetBiosLookup(Data: TNetbiosTask): boolean;
const
  NB_REQUEST        = #$A2#$48#$00#$00#$00#$01#$00#$00 +
    #$00#$00#$00#$00#$20#$43#$4B#$41 +
    #$41#$41#$41#$41#$41#$41#$41#$41 +
    #$41#$41#$41#$41#$41#$41#$41#$41 +
    #$41#$41#$41#$41#$41#$41#$41#$41 +
    #$41#$41#$41#$41#$41#$00#$00#$21 +
    #$00#$01;

  NB_PORT           = 137;
  NB_BUFSIZE        = 8192;
var
  Buffer            : TIdBytes;
  I                 : Integer;
  RepName           : string;
  UDPClient         : TIdUDPClient;
  msg_prm           : PWMUCommand;
begin
  RepName := '';
  Result := False;
  UDPClient := nil;

  UDPClient := TIdUDPClient.Create(nil);
  try
    try
      with UDPClient do
      begin
        Host := Trim(Data.sAddress);
        Port := NB_PORT;

        Send(NB_REQUEST);
      end;

      SetLength(Buffer, NB_BUFSIZE);
      if (0 < UDPClient.ReceiveBuffer(Buffer, Data.iTimeout)) then
      begin

        for I := 1 to 15 do
          RepName := RepName + Chr(Buffer[56 + I]);

        RepName := Trim(RepName);
        Data.sHostname := RepName;

        Result := True;
      end;

    except
      Result := False;
    end;
  finally
    if Assigned(UDPClient) then
      FreeAndNil(UDPClient);
  end;

  New(msg_prm);
  msg_prm.host := RepName;
  msg_prm.ip := Data.sAddress;
  msg_prm.bOnline := Length(RepName) > 0;

  PostMessage(Data.hMainForm, WM_POSTED_MSG, WM_THRD_SITE_MSG, integer(msg_prm));

end;

procedure TForm2.Button1Click(Sender: TObject);
var
  i                 : integer;
  ArrNetbiosTasks   : array of TNetbiosTask;
  sIp               : string;
begin
  //

  SetMaxAsyncCallThreads(50);

  SetLength(ArrNetbiosTasks, 255);
  sIp := '192.168.1.';
  for i := 1 to 255 do
  begin

    ArrNetbiosTasks[i - 1].hMainForm := Self.Handle;
    ArrNetbiosTasks[i - 1].sAddress := Concat(sIp, IntToStr(i));
    ArrNetbiosTasks[i - 1].iTimeout := 5000;

    AsyncCallEx(@NetBiosLookup, ArrNetbiosTasks[i - 1]);
    Application.ProcessMessages;
  end;
end;

procedure TForm2.ThreadMessage(var Msg: TMessage);
var
  msg_prm           : PWMUCommand;
begin
  //
  case Msg.WParam of
    WM_THRD_SITE_MSG:
      begin
        msg_prm := PWMUCommand(Msg.LParam);
        try
          Memo1.Lines.Add(msg_prm.ip + ' = ' + msg_prm.host + ' --- Online? ' + BoolToStr(msg_prm.bOnline));
        finally
          Dispose(msg_prm);
        end;
      end;
  end;

end;

end.

- Mick

---

我这里没有看到任何错误。你确定它不工作吗？ - Rafael Colucci

代码在单个新线程中执行，但是它是一个接着一个地处理请求，而不是同时执行多个请求。理想情况下，我希望它能生成10-50个工作线程，并让这些工作线程完成所有任务，直到没有剩余任务为止。 - Mick

Answer 1

有点棘手。我进行了一些调试（实际上是相当多的调试），发现AsyncCallsEx中的代码块在第1296行：

Result := TAsyncCallArgRecord.Create(Proc, @Arg).ExecuteAsync;

进一步的调查显示，在 System.pas 文件中的接口复制（_IntfCopy）处被阻止。

CALL    DWORD PTR [EAX] + VMTOFFSET IInterface._Release

看起来，与同一代码的Pascal版本相比，这行代码释放了先前存储在目标参数中的引用计数。但是，目标是一个Result，在调用者（您的代码）中未被使用。

现在进入棘手的部分。

AsyncCallEx返回一个接口，在您的情况下，调用者会将其丢弃。因此，理论上编译后的代码（以伪代码形式）应该如下所示：

loop
  tmp := AsyncCallEx(...)
  tmp._Release
until

然而编译器会对此进行优化，使其变得更加高效。

loop
   tmp := AsyncCallEx(...)
until
tmp._Release

为什么？因为它知道分配接口会自动释放存储在 tmp 变量中的接口的引用计数（在 _IntfCopy 中调用 _Release）。因此没有必要显式地调用 _Release。

但是释放 IAsyncCall 会导致代码等待线程完成。所以每次调用 AsyncCallEx 时，您都需要等待上一个线程完成...

我不知道如何使用 AsyncCalls 解决这个问题。我尝试了这种方法，但某种程度上并没有完全按预期工作（在 ping 约50个地址后程序会阻塞）。

type
  TNetbiosTask = record
    //... as before ...
    thread: IAsyncCall;
  end;

  for i := 1 to 255 do
  begin

    ArrNetbiosTasks[i - 1].hMainForm := Self.Handle;
    ArrNetbiosTasks[i - 1].sAddress := Concat(sIp, IntToStr(i));
    ArrNetbiosTasks[i - 1].iTimeout := 5000;

    ArrNetbiosTasks[i - 1].thread := AsyncCallEx(@NetBiosLookup, ArrNetbiosTasks[i - 1]);
    Application.ProcessMessages;
  end;
  for i := 1 to 255 do // wait on all threads
    ArrNetbiosTasks[i - 1].thread := nil;

- gabr

---

感谢您详细的回答。看起来AsyncCalls不是这个任务的合适工具。 - Mick

Answer 2

如果您调用AsyncCallEx()或任何其他AsyncCalls函数，您将返回一个IAsyncCall接口指针。如果它的引用计数达到0，底层对象将被销毁，这将等待工作线程代码完成。您在循环中调用AsyncCallEx()，因此每次返回的接口指针将被分配给相同的（隐藏的）变量，递减引用计数，从而同步释放先前的异步调用对象。

为了解决这个问题，只需向窗体类添加一个私有的IAsyncCall数组，如下所示：

private
  fASyncCalls: array[byte] of IAsyncCall;

并将返回的接口指针分配给数组元素：

fASyncCalls[i] := AsyncCallEx(@NetBiosLookup, ArrNetbiosTasks[i - 1]);

这将使接口保持活跃并启用并行执行。

请注意，这只是一般想法，当调用返回时，您应该添加代码以重置相应的数组元素，并在释放表单之前等待所有调用完成。

- mghie