Is it possible to create a thread pool using AsyncCalls unit?

I am attempting to perform a Netbios lookup on an entire class C subnet using AsyncCalls. Ideally I'd like it to perform 10+ lookups concurrently but it currently only does 1 lookup at a time. What am I doing wrong here?

My form contains 1 button and 1 memo.

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.

Tricky stuff. I did some debugging (well, quite some debugging) and found out that the code blocks in AsyncCallsEx in line 1296:

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

Further digging showed that it blocks in interface copy in System.pas (_IntfCopy) at

CALL    DWORD PTR [EAX] + VMTOFFSET IInterface._Release

Looking at the pascal version of the same code it seems that this line release the reference count stored previously in the destination parameter. Destination, however, is a Result which is not used in the caller (your code).

Now comes the tricky part.

AsyncCallEx returns an interface which (in you case) the caller throws away. So in theory the compiled code (in pseudo form) should look like this

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

However the compiler optimizes this to

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

Why? Because it knows that assigning the interface will release the reference count of the interface stored in the tmp variable automatically (the call to _Release in _IntfCopy). So there's no need to explicitely call _Release.

Releasing the IAsyncCall however causes the code to wait on thread completion. So basically you wait for the previous thread to complete each time you call AsyncCallEx ...

I don't know how to nicely solve this using AsyncCalls. I tried this approach but somehow it is not working completely as expected (program blocks after pinging about 50 addresses).

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;

If you call AsyncCallEx() or any other of the AsyncCalls functions you are returned a IAsyncCall interface pointer. If its reference counter reaches 0 the underlying object is destroyed, which will wait for the worker thread code to complete. You are calling AsyncCallEx() in a loop, so each time the returned interface pointer will be assigned to the same (hidden) variable, decrementing the reference counter and thus synchronously freeing the previous asynchronous call object.

To work around this simply add a private array of IAsyncCall to the form class, like so:

private
  fASyncCalls: array[byte] of IAsyncCall;

and assign the returned interface pointers to the array elements:

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

This will keep the interfaces alive and enable parallel execution.

Note that this is just the general idea, you should add code to reset the corresponding array element when a call returns, and wait for all calls to complete before you free the form.