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

Question

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.

Answer 1

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;

Answer 2

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.