I have a program which uses a Thread that performs some work. The thread should notify another thread (in this example the main thread) of the progress.
If I use Synchronize() to perform the synchronization everything works as expected. If I synchronize with the main thread and publish the for-variable and put it into a list every single value get's printed correctly into my ListBox:
procedure TWorkerThread.Execute;
var
i: Integer;
begin
inherited;
for i := 1 to 1000 do
begin
Synchronize(
procedure()
begin
FireEvent(i);
end);
end;
end;
Output: 1, 2, 3, 4, 5 ... 1000
If I use Queue() to perform the synchronization the output is not as expected:
procedure TWorkerThread.Execute;
var
i: Integer;
begin
inherited;
for i := 1 to 1000 do
begin
Queue(
procedure()
begin
FireEvent(i);
end);
end;
end;
Output: 200, 339, 562, 934, 1001, 1001, 1001, 1001, 1001, 1001, 1001, 1001, 1001, [...]
What's happening here? As of my understanding the anonymous procedure should capture the variable "i"?
The anonymous procedure captures the variable reference.
This means that the value is undetermined when the anonymous procedure runs.
In order to capture a value, you will have to wrap it into a unique frame like this:
Type
TWorkerThread = class (TThread)
...
function GetEventProc(ix : Integer): TThreadProcedure;
end;
function TWorkerThread.GetEventProc(ix : Integer) : TThreadProcedure;
// Each time this function is called, a new frame capturing ix
// (and its current value) will be produced.
begin
Result := procedure begin FireEvent(ix); end;
end;
procedure TWorkerThread.Execute;
var
i: Integer;
begin
inherited;
for i := 1 to 1000 do
begin
Queue( GetEventProc(i));
end;
end;
See also Anonymous methods - variable capture versus value capture.
Related
I have found this Remy's interesting code.
Delphi : How to create and use Thread locally?
Can this be done so I can do multiple threads and wait until they are all finished and then continue with main thread? I tried it like this but no success...
procedure Requery(DataList: TStringList);
var
Event: TEvent;
H: THandle;
OpResult: array of Boolean;
i: Integer;
begin
Event := TEvent.Create;
try
SetLength(OpResult, DataList.Count);
for i:=0 to DataList.Count-1 do begin
TThread.CreateAnonymousThread(
procedure
begin
try
// run query in thread
OpResult[i]:=IsMyValueOK(DataList.Strings[i]);
finally
Event.SetEvent;
end;
end
).Start;
H := Event.Handle;
end;
while MsgWaitForMultipleObjects(1, H, False, INFINITE, QS_ALLINPUT) = (WAIT_OBJECT_0+1) do Application.ProcessMessages;
for i:=Low(OpResult) to High(OpResult) do begin
Memo1.Lines.Add('Value is: ' + BoolToStr(OpResult[i], True));
end;
finally
Event.Free;
end;
// Do next jobs with query
...
end;
Can this be done so I can do multiple threads and wait until they are all finished
Yes. You simply need to create multiple TEvent objects, one for each TThread, and then store all of their Handles in an array to pass to MsgWaitForMultipleObjects():
procedure Requery(DataList: TStringList);
var
Events: array of TEvent;
H: array of THandle;
OpResult: array of Boolean;
i: Integer;
Ret, Count: DWORD;
// moved into a helper function so that the anonymous procedure
// can capture the correct Index...
procedure StartThread(Index: integer);
begin
Events[Index] := TEvent.Create;
TThread.CreateAnonymousThread(
procedure
begin
try
// run query in thread
OpResult[Index] := IsMyValueOK(DataList.Strings[Index]);
finally
Events[Index].SetEvent;
end;
end
).Start;
H[Index] := Events[Index].Handle;
end;
begin
if DataList.Count > 0 then
begin
SetLength(Events, DataList.Count);
SetLength(H, DataList.Count);
SetLength(OpResult, DataList.Count);
try
for i := 0 to DataList.Count-1 do begin
StartThread(i);
end;
Count := Length(H);
repeat
Ret := MsgWaitForMultipleObjects(Count, H[0], False, INFINITE, QS_ALLINPUT);
if Ret = WAIT_FAILED then RaiseLastOSError;
if Ret = (WAIT_OBJECT_0+Count) then
begin
Application.ProcessMessages;
Continue;
end;
for i := Integer(Ret-WAIT_OBJECT_0)+1 to High(H) do begin
H[i-1] := H[i];
end;
Dec(Count);
until Count = 0;
for i := Low(OpResult) to High(OpResult) do begin
Memo1.Lines.Add('Value is: ' + BoolToStr(OpResult[i], True));
end;
finally
for i := Low(Events) to High(Events) do begin
Events[i].Free;
end;
end;
end;
// Do next jobs with query
...
end;
That being said, you could alternatively get rid of the TEvent objects and wait on the TThread.Handles instead. A thread's Handle is signaled for a wait operation when the thread is fully terminated. The only gotcha is that TThread.CreateAnonymousThread() creates a TThread whose FreeOnTerminate property is True, so you will have to turn that off manually:
procedure Requery(DataList: TStringList);
var
Threads: array of TThread;
H: array of THandle;
OpResult: array of Boolean;
i: Integer;
Ret, Count: DWORD;
// moved into a helper function so that the anonymous procedure
// can capture the correct Index...
procedure StartThread(Index: integer);
begin
Threads[Index] := TThread.CreateAnonymousThread(
procedure
begin
// run query in thread
OpResult[Index] := IsMyValueOK(DataList.Strings[Index]);
end
);
Threads[Index].FreeOnTerminate := False;
H[Index] := Threads[Index].Handle;
Threads[Index].Start;
end;
begin
try
SetLength(Threads, DataList.Count);
SetLength(H, DataList.Count);
SetLength(OpResult, DataList.Count);
for i := 0 to DataList.Count-1 do begin
StartThread(i);
end;
Count := Length(H);
repeat
Ret := MsgWaitForMultipleObjects(Count, H[0], False, INFINITE, QS_ALLINPUT);
if Ret = WAIT_FAILED then RaiseLastOSError;
if Ret = (WAIT_OBJECT_0+Count) then
begin
Application.ProcessMessages;
Continue;
end;
for i := Integer(Ret-WAIT_OBJECT_0)+1 to High(H) do begin
H[i-1] := H[i];
end;
Dec(Count);
until Count = 0;
for i := Low(OpResult) to High(OpResult) do begin
Memo1.Lines.Add('Value is: ' + BoolToStr(OpResult[i], True));
end;
finally
for i := Low(Threads) to High(Threads) do begin
Threads[i].Free;
end;
end;
// Do next jobs with query
...
end;
Either way, note that MsgWaitForMultipleObjects() is limited to waiting on a maximum of 63 (MAXIMUM_WAIT_OBJECTS[64] - 1) handles at a time. The WaitForMultipleObjects() documentation explains how to work around that limitation, if you need to:
To wait on more than MAXIMUM_WAIT_OBJECTS handles, use one of the following methods:
Create a thread to wait on MAXIMUM_WAIT_OBJECTS handles, then wait on that thread plus the other handles. Use this technique to break the handles into groups of MAXIMUM_WAIT_OBJECTS.
Call RegisterWaitForSingleObject to wait on each handle. A wait thread from the thread pool waits on MAXIMUM_WAIT_OBJECTS registered objects and assigns a worker thread after the object is signaled or the time-out interval expires.
Or, you could simply process your list in smaller batches, say no more than 50-60 items at a time.
In a System.Threading.TParallel.For loop, I need to write-access a string variable which is declared outside of the TParallel.For loop threads:
// Main thread:
procedure TForm2.GetWeather;
var
CurrentWeather: string;
begin
CurrentWeather := 'Current weather: ';
System.Threading.TParallel.For(1, 10,
procedure(idx: Integer)
begin
if IsRainy(idx) then
begin
// loop thread needs to write-access a mainthread-string-variable:
CurrentWeather := CurrentWeather + 'bad weather, ';
end;
end);
Self.Caption := CurrentWeather;
end;
But according to the documentation, this should not be done. And System.SyncObjs.TInterlocked doesn't seem to have a method to write to a string variable.
So how can I write to the CurrentWeather variable in this case?
Delphi 10.1.2 Berlin
EDIT:
Following the advice of David Heffernan I rewrote the code - is this correct?:
// Main thread:
procedure TForm2.GetWeather;
var
CurrentWeather: string;
ALock: TCriticalSection;
begin
CurrentWeather := 'Current weather: ';
ALock := TCriticalSection.Create;
try
System.Threading.TParallel.For(1, 10,
procedure(idx: Integer)
begin
if IsRainy(idx) then
begin
ALock.Enter;
try
CurrentWeather := CurrentWeather + 'bad weather, ';
finally
ALock.Leave;
end;
end;
end);
finally
ALock.Free;
end;
Self.Caption := CurrentWeather;
end;
You need to use a lock to modify complex data types like string. This cannot be done atomically.
Use TCriticalSection if you target just Windows. For code that targets other platforms then you should use TMonitor.
Another option is to use TThread.Queue, for example like this (this assumes that you want to update caption dynamically, rather than accumulate result and show it after all threads are finished)
procedure TForm1.Button6Click(Sender: TObject);
begin
Caption := 'Current weather: ';
TParallel.For(1, 10,
procedure(idx: Integer)
begin
if IsRainy(idx) then
begin
// loop thread needs to write-access a mainthread-string-variable:
TThread.Queue(TThread.Current,
procedure
begin
Caption := Caption + 'bad weather, ';
end)
end;
end);
end;
I'm developing a multithread download application. I have one thread that creates many threads that download data. While downloading I need to see the progress in progress bar, so I set the maximum as the size of the file, and I calculate current downloaded data by using IdHTTPWork, which I added as a procedure of thread (secondary thread). When my app is started, the main thread creates other threads to download (in the loop for) and set the position of begin and end (idhttp.request.range), then each thread starts downloading like this:
HTTP.Request.Range := Format('%d-%d',[begin ,end]);
HTTP.Get(url,fs);
this is the procedure of secondarythread.work:
procedure TSecondaryThread.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
if AWorkMode = wmRead then
position:= AWorkCount;// position is a global variable
SendMessage(HWND_BROADCAST,MyMessage, 2,position);
end;
I don't know if this is the right code, but I can't find another solution. Each thread can increment position using the value of downloaded data, so position will contain the global downloads in instant S, I don't know if this is true.
Now my questions:
1- the progress doesn't correspond to the current amount of downloaded data; instead, it increments very slowly.
2-when I add -just when I add- Asend message in this procedure, it never stops working!!
So what is the problem?
You have the right idea by giving each worker thread its own TIdHTTP object and its own OnWork event handler. But you are not delivering those status updates to the main thread correctly.
Use PostMessage() instead of SendMessage() so that you do not slow down your worker threads.
You have multiple worker threads posting status updates to the main thread, so DO NOT use a global variable to hold the progress, and certainly DO NOT have the worker threads update that variable directly. Each worker thread should put its current status directly in the parameters of the message that gets posted to the main thread, and then the main thread can have a private counter variable that it increments with each status update.
DO NOT post the status updates using HWND_BROADCAST - that broadcasts the message to every top-level window in the system! Post the messages only to your main thread, by posting to an HWND that belongs to the main thread (I would suggest using AllocateHWnd() for that).
Try something like this:
unit StatusUpdates;
uses
Windows;
interface
type
PStatus = ^TStatus;
TStatus = record
BytesDownloadedThisTime: Int64;
BytesDownloadedSoFar: Int64;
MaxBytesBeingDownloaded: Int64;
end;
var
StatusUpdateWnd: HWND = 0;
implementation
end.
uses
..., StatusUpdates;
type
TMainForm = class(TForm)
...
private
TotalDownloaded: Int64;
...
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
StatusUpdateWnd := AllocateHWnd(StatusWndProc);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
if StatusUpdateWnd <> 0 then
begin
DeallocateHWnd(StatusUpdateWnd);
StatusUpdateWnd := 0;
end;
end;
procedure TMainForm.StartDownload;
begin
ProgressBar1.Position := 0;
ProgressBar1.Max := FileSizeToBeDownloaded;
TotalDownloaded := 0;
// create download threads...
end;
procedure TMainForm.StatusWndProc(var Message: TMessage);
var
Status: PStatus;
begin
if Message.Msg = MyMessage then
begin
Status := PStatus(Message.LParam);
try
if Status.BytesDownloadedThisTime > 0 then
begin
Inc(TotalDownloaded, Status.BytesDownloadedThisTime);
ProgressBar1.Position := TotalDownloaded;
end;
// use Status for other things as needed...
finally
Dispose(Status);
end;
end else
Message.Result := DefWindowProc(StatusUpdateWnd, Message.Msg, Message.WParam, Message.LParam);
end;
uses
..., StatusUpdates;
type
TSecondaryThread = class(TThread)
private
FTotalBytes: Int64;
FMaxBytes: Int64;
procedure PostStatus(BytesThisTime: Int64);
...
end;
procedure TSecondaryThread.PostStatus(BytesThisTime: Int64);
var
Status: PStatus;
begin
New(Status);
Status.BytesDownloadedThisTime := BytesThisTime;
Status.BytesDownloadedSoFar := FTotalBytes;
Status.MaxBytesBeingDownloaded := FMaxBytes;
if not PostMessage(StatusUpdateWnd, MyMessage, 2, LPARAM(Status)) then
Dispose(Status);
end;
procedure TSecondaryThread.IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
if AWorkMode = wmRead then
begin
FTotalBytes := 0;
FMaxBytes := AWorkCountMax;
PostStatus(0);
end;
end;
procedure TSecondaryThread.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
BytesThisTime: Int64;
begin
if AWorkMode = wmRead then
begin
BytesThisTime := AWorkCount - FTotalBytes;
FTotalBytes := AWorkCount;
PostStatus(BytesThisTime);
end;
end;
I have an application with 50 threads that do something and I want my procedure (btnTestClick) to wait until all threads are terminated. I've tried with global variable as counter and with WaitForMultipleObjects(threadCount, #threadArr, True, INFINITE); but the procedure never waits for all threads to terminate.Here is how my thread looks like :
TClientThread = class(TThread)
protected
procedure Execute; override;
public
constructor create(isSuspended : Boolean = False);
end;
And here are the constructor and the execute procedure :
constructor TClientThread.create(isSuspended : Boolean);
begin
inherited Create(isSuspended);
FreeOnTerminate := True;
end;
procedure TClientThread.Execute;
var
begin
inherited;
criticalSection.Enter;
try
Inc(globalThreadCounter);
finally
criticalSection.Leave;
end;
end;
And my OnButtonClick is this :
procedure TMainForm.btnTestClick(Sender: TObject);
var
clientThreads : array of TClientThread;
i, clientThreadsNum : Integer;
begin
clientThreadsNum := 50;
SetLength(clientThreads, clientThreadsNum);
for i := 0 to Length(clientThreads) - 1 do begin // РЕДАКТИРАЙ !!
clientThreads[i] := TClientThread.Create(True);
end;
// here I will assign some variables to the suspended threads, but that's not important here
for i := 0 to Length(clientThreads) - 1 do begin
clientThreads[i].Start;
end;
WaitForMultipleObjects(clientThreadsNum, #clientThreads, True, INFINITE);
// do something after all threads are terminated
end;
You code reads:
WaitForMultipleObjects(clientThreadsNum, #clientThreads, True, INFINITE);
where clientThreads is of type:
array of TClientThread
Now, #clientThreads is the address of the dynamic array. That is the address of a pointer to the first thread object. But you are expected to pass a pointer to the first thread handle, something utterly different. So instead you need to form a list of thread handles:
var
ThreadHandles: array of THandle;
....
SetLength(ThreadHandles, Length(clientThreads));
for i := 0 to high(clientThreads) do
ThreadHandles[i] := clientThreads[i].Handle;
WaitForMultipleObjects(clientThreadsNum, Pointer(ThreadHandles), True, INFINITE);
You would have discovered that your call to WaitForMultipleObjects was incorrect had you checked the return value. A basic rule of Win32 programming, one that you should strive not to break, is that you check the values returned by function calls.
I believe that your call to WaitForMultipleObjects will return WAIT_FAILED. When that happens you can call GetLastError to find out what went wrong. You should modify your code to perform proper error checking. Take good care to read the documentation to find out how to do so.
I have a unit something like this
type
TMyClass = Class(TObject)
private
AnInteger : Integer;
MyThreadHandle : DWORD;
procedure MyPrivateProcedure;
public
procedure MyPublicProcedure;
end;
procedure TMyClass.MyPrivateProcedure;
procedure MyThread; stdcall;
begin
if AnInteger <> 0 then MyPublicProcedure;
end;
var
DummyID: DWORD;
begin
MyThreadHandle := CreateThread(NIL,0,#MyThread,NIL,0, DummyID);
end;
procedure TMyClass.MyPublicProcedure;
begin
AnInteger := 0;
end;
My goal is to have a Thread (no TTthread please.) that can "access" the vars/functions/procedures just like it's part of the class. This Example fails because it doesn't have access to the vars nor to the procedure. This is just an example, I am aware that the Integer can't change just like that. To me it's just important to have a thread that is part of the class. I also tried to pass the integer as a pointer (which worked) to the thread but I still can't access a procedure/function of the class. any ideas?
You can use TThread and keep filesize small. I think you are going into a difficult path: reinvent the wheel is time consuming, I can tell you that! :)
Here is some working code to initialize the thread:
function ThreadProc(Thread: TThread): Integer;
var FreeThread: Boolean;
begin
if not Thread.FTerminated then
try
result := 0; // default ExitCode
try
Thread.Execute;
except
on Exception do
result := -1;
end;
finally
FreeThread := Thread.FFreeOnTerminate;
Thread.FFinished := True;
if Assigned(Thread.OnTerminate) then
Thread.OnTerminate(Thread);
if FreeThread then
Thread.Free;
EndThread(result);
end;
end;
constructor TThread.Create(CreateSuspended: Boolean);
begin
IsMultiThread := true; // for FastMM4 locking, e.g.
inherited Create;
FSuspended := CreateSuspended;
FCreateSuspended := CreateSuspended;
FHandle := BeginThread(nil, 0, #ThreadProc, Pointer(Self), CREATE_SUSPENDED, FThreadID);
if FHandle = 0 then
raise Exception.Create(SysErrorMessage(GetLastError));
SetThreadPriority(FHandle, THREAD_PRIORITY_NORMAL);
end;
That is, you pass the object as pointer() to the thread creation API, which will be passed as the unique parameter of the ThreadProc.
The ThreadProc should NOT be part of any method, but global to the unit.
Here is another piece of code directly calling the APIs to handle multi-thread compression, with no overhead, and synchronization:
type
TThreadParams = record
bIn, bOut: pAESBlock;
BlockCount: integer;
Encrypt: boolean;
ID: DWORD;
AES: TAES;
end;
{ we use direct Windows threads, since we don't need any exception handling
nor memory usage inside the Thread handler
-> avoid classes.TThread and system.BeginThread() use
-> application is still "officialy" mono-threaded (i.e. IsMultiThread=false),
for faster System.pas and FastMM4 (no locking)
-> code is even shorter then original one using TThread }
function ThreadWrapper(var P: TThreadParams): Integer; stdcall;
begin
with P do
AES.DoBlocks(bIn,bOut,bIn,bOut,BlockCount,Encrypt);
ExitThread(0);
result := 0; // make the compiler happy, but won't never be called
end;
procedure TAES.DoBlocksThread(var bIn, bOut: PAESBlock; Count: integer; doEncrypt: boolean);
var Thread: array[0..3] of TThreadParams; // faster than dynamic array
Handle: array[0..3] of THandle; // high(Thread) is not compiled by XE2
nThread, i, nOne: integer;
pIn, pOut: PAESBlock;
begin
if Count=0 then exit;
if {$ifdef USEPADLOCK} padlock_available or {$endif}
(SystemInfo.dwNumberOfProcessors<=1) or // (DebugHook<>0) or
(Count<((512*1024) div AESBlockSize)) then begin // not needed below 512 KB
DoBlocks(bIn,bOut,bIn,bOut,Count,doEncrypt);
exit;
end;
nThread := SystemInfo.dwNumberOfProcessors;
if nThread>length(Thread) then // a quad-core is enough ;)
nThread := length(Thread);
nOne := Count div nThread;
pIn := bIn;
pOut := bOut;
for i := 0 to nThread-1 do
with Thread[i] do begin // create threads parameters
bIn := pIn;
bOut := pOut;
BlockCount := nOne;
Encrypt := doEncrypt;
AES := self; // local copy of the AES context for every thread
Handle[i] := CreateThread(nil,0,#ThreadWrapper,#Thread[i],0,ID);
inc(pIn,nOne);
inc(pOut,nOne);
dec(Count,nOne);
end;
if Count>0 then
DoBlocks(pIn,pOut,pIn,pOut,Count,doEncrypt); // remaining blocks
inc(Count,nOne*nThread);
assert(integer(pIn)-integer(bIn)=Count*AESBlockSize);
assert(integer(pOut)-integer(bOut)=Count*AESBlockSize);
bIn := pIn;
bOut := pOut;
WaitForMultipleObjects(nThread,#Handle[0],True,INFINITE);
for i := 0 to nThread-1 do
CloseHandle(Handle[i]);
end;
A thread has its own stack pointer, so you can't access local variables or parameters (like the hidden Self parameter) in you MyThread local procedure (which BTW is declared wrong). Furthermore you can't use local procedures for threads if they access variables (including Self) from the outer function. And if you want to use the 64bit compiler in the future, you can't use local procedures for any callback.
In your case you just have to fix the declaration of your procedure and move it into the unit scope (make it a "stand alone" procedure. This allows you to use the thread-callback parameter for "Self".
function MyThread(MyObj: TMyClass): DWORD; stdcall;
begin
if MyObj.AnInteger <> 0 then
MyObj.MyPublicProcedure;
Result := 0;
end;
procedure TMyClass.MyPrivateProcedure;
var
DummyID: DWORD;
begin
MyThreadHandle := CreateThread(nil, 0, #MyThread, Self, 0, DummyID);
end;