Is it possible to create a thread pool using the AsyncCalls block?

Question

I am trying to do a Netbios search for an entire class C subnet using AsyncCalls . Ideally, I would like it to perform a 10+ search at a time, but currently it only performs one search at a time. What am I doing wrong here?

My form contains 1 button and 1 note.

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

Tricks. I did some debugging (well, pretty some debugging) and found out that the code blocks in AsyncCallsEx are on line 1296:

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

Further digging showed that it blocks copying the interface in System.pas (_IntfCopy) in

 CALL DWORD PTR [EAX] + VMTOFFSET IInterface._Release 

Looking at the pascal version of the same code, it seems that this line frees up the reference count stored earlier in the target parameter. The assignment, however, is a result that is not used by the caller (your code).

Now comes the hard part.

AsyncCallEx returns the interface that (in your case) the caller throws. Therefore, a theoretically compiled code (in pseudo form) should look like this:

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

However, the compiler optimizes this for

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

Why? Because he knows that assigning an interface will automatically release the reference count of the interface stored in the tmp variable (calling _Release in _IntfCopy). Therefore, there is no need to explicitly call _Release.

Releasing IAsyncCall causes the code to wait for the thread to complete. So basically you wait until the previous thread completes every time you call AsyncCallEx ...

I do not know how to beautifully solve this problem with AsyncCalls. I tried this approach, but somehow it does not work as expected (program blocks after ping 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 of the other AsyncCalls functions, the IAsyncCall interface pointer is returned to you. If its reference count reaches 0 , the main object will be destroyed and it will wait for the workflow code to complete. You call AsyncCallEx() in a loop, so every time the returned interface pointer is assigned to the same (hidden) variable, decreasing the reference count and thereby synchronously freeing the previous asynchronous call object.

To get around this, simply add a private IAsyncCall array to the form class, for example:

 private fASyncCalls: array[byte] of IAsyncCall; 

and assign return interface pointers to array elements:

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

This will save interfaces and ensure parallel execution.

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