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.
Related
I need to run multiples blocks of threads at same time. What Im trying to do is:
A have 197 operation do call individualy on shellExecute
I want to run 4 operations simultanelly
I can only start new operation if I have less then 4 executing
Problems:
I have to insert a lot of Application.ProcessMessages to make it work, and I dont know what Im doing wrong. I tryed everything and nothing seems to work.
Here is the code:
procedure TCompress.NewThread(psArgs: PWideChar);
var
oThread: TThread;
nCode : DWord;
begin
oThread := TThread.CreateAnonymousThread(
procedure
begin
try
FNumberOfThreads := FNumberOfThreads +1;
ExecuteAndWait(PChar(FsPathCompressor), psArgs, SW_HIDE, nCode);
//It is just a CreateProcess with WaitForSingleObject(retorno, INFINITE);
except on E: Exception do
begin
raise;
end;
end;
end);
oThread.OnTerminate := DoOnTerminate;
oThread.Start;
end;
procedure TspCompress.DoOnTerminate;
begin
FNumberOfThreads := FNumberOfThreads -1;
end;
function TspCompress.ExecuteBlocks: Boolean;
var
sArgs : WideString;
nBlocksCreated, nTotalBlocks: Integer;
begin
nTotalBlocks := 197;
nBlocksCreated := 0;
while nBlocksCreated < nTotalBlocks do
begin
//Needs Application.ProcessMessages to update FNumberOfThreads.
while (FNumberOfThreads < 4) and (nBlocksCreated < nTotalBlocks) do
begin
try
sArgs := PChar('C:/file.exe');
NewThread(PWideChar(sArgs));
//Needs Application.ProcessMessages to start the thread.
nBlocksCreated := nBlocksCreated + 1;
except
on E: Exception do
begin
//Do Something
end;
end;
end;
end;
end;
FNumberOfThreads is a private variable of the class
This is a sample code of what Im doing. The problem is not with the code it self, but with the Thread concept.
At the end, I just used System.Threading. Setting a ThreadPool and using Parellel.For.
procedure TCompress.MyParallelProcess;
var
sArgs : WideString;
nTotalProcess: Integer;
oPool: TThreadPool;
nCode: DWord;
begin
oPool := TThreadPool.Create;
try
oPool.SetMinWorkerThreads(4);
oPool.SetMaxWorkerThreads(4);
nTotalProcess := 197;
TParallel.For(1, nTotalProcess, procedure(i: integer)
begin
sArgs := PChar('C:/file'+IntToStr(i)+'.exe');
ExecuteAndWait(PChar(FsPathCompressor), sArgs, SW_HIDE, nCode);
end, oPool);
finally
FreeAndNil(oPool);
end;
end;
Remember, this is just a sample code, but i did something like this and works as a glove.
Thanks all for your help.
I use Delphi 7. I create a record that stores info, and using pointers I store that record as an object in a TreeView with more than 100 items.
My problem is, how to release or eliminate all these objects from memory?
type
PMyRec = ^TMyRec;
TMyRec = record
Tipo: string;
parent: string;
end;
var
MyRecPtr: PMyRec;
for x := 1 to 100 do
begin
New(MyRecPtr);
MyRecPtr^.Tipo := '1';
MyRecPtr^.parent := 'paul';
Tree1.Items.AddChildObject(nil, IntToStr(x) + '-NewItem', MyRecPtr);
ListaDePonteiros.Add( MyRecPtr ); // I use a TList to store pointers
ListaDeObjectos.Add( MyRecPtr ); // I use a TList to store Objects
end;
How I try to delete them all:
procedure TForm1.Button2Click(Sender: TObject);
procedure EmptyTList(Var AList: TList);
var
intContador: integer;
begin
for intContador := (AList.Count-1) downto 0 do
begin
if Assigned(AList.Items[intContador]) then
begin
Dispose(AList.Items[intContador]);
AList.Items[intContador] := nil;
AList.Delete(intContador);
end;
end;
end;
begin
if Assigned(MyRecPtr) then
begin
EmptyTList(ListaDePonteiros);
end;
end;
When I delete all items in the TreeView OnDelete event, I have this:
if assigned(Node.Data) then
begin
Dispose(Node.Data);
end;
What I want to do is release all objects from memory!
If I dispose all objects using that list then if I delete any item from the TreeView an invalid pointer error is raised!!
Even with all pointers disposed, MyRecPtr still points to somewhere in memory, and Node.Data too!
Your code is crashing because you are freeing the same memory twice, because you have not defined any clear ownership of your record instances.
Your ListaDePonteiros and ListaDeObjectos lists are redundant and can be removed. The TTreeView can be the owner of the records and you can simply Dispose() of them in the TTreeView.OnDeletion event and be done with it 1.
var
MyRecPtr: PMyRec;
for x := 1 to 100 do
begin
New(MyRecPtr);
try
MyRecPtr^.Tipo := '1';
MyRecPtr^.parent := 'paul';
Tree1.Items.AddChildObject(nil, IntToStr(x) + '-NewItem', MyRecPtr);
except
Dispose(MyRecPtr);
raise;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Tree1.Items.Clear;
end;
procedure TForm1.Tree1Deletion(Sender: TObject; Node: TTreeNode);
begin
if Assigned(Node.Data) then
Dispose(PMyRec(Node.Data));
end;
Otherwise, if you choose to keep a separate list, keep the ListaDeObjectos list and remove the ListaDePonteiros list (as there is no reason to maintain 2 lists tracking the exact same values). You would just need to decide whether you want ListaDeObjectos or Tree1 to own the records you allocate:
If ListaDeObjectos is to be the owner, DO NOT call Dispose(Node.Data) in the TTreeView.OnDeletion event.
var
MyRecPtr: PMyRec;
Idx: Integer;
for x := 1 to 100 do
begin
New(MyRecPtr);
try
MyRecPtr^.Tipo := '1';
MyRecPtr^.parent := 'paul';
Idx := ListaDeObjectos.Add(MyRecPtr);
try
Tree1.Items.AddChildObject(nil, IntToStr(x) + '-NewItem', MyRecPtr);
except
ListaDeObjectos.Delete(Idx);
raise;
end;
except
Dispose(MyRecPtr);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
procedure EmptyTList(AList: TList);
var
intContador: integer;
begin
for intContador := 0 to (AList.Count-1) do
Dispose(PMyRec(AList[intContador]));
AList.Clear;
end;
begin
Tree1.Items.Clear;
EmptyTList(ListaDePonteiros);
end;
If Tree1 is to be the owner, DO NOT call Dispose(AList.Items[intContador]) in EmptyTList() (in fact, you can get rid of EmptyTList() altogether and just call ListaDeObjectos.Clear() when needed).
var
MyRecPtr: PMyRec;
Node: TNode;
for x := 1 to 100 do
begin
New(MyRecPtr);
try
MyRecPtr^.Tipo := '1';
MyRecPtr^.parent := 'paul';
Node := Tree1.Items.AddChildObject(nil, IntToStr(x) + '-NewItem', MyRecPtr);
except
Dispose(MyRecPtr);
raise;
end;
try
ListaDePonteiros.Add(MyRecPtr);
except
Node.Free;
raise;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ListaDePonteiros.Clear;
Tree1.Items.Clear;
end;
procedure TForm1.Tree1Deletion(Sender: TObject; Node: TNode);
begin
if Assigned(Node.Data) then
Dispose(PMyRec(Node.Data));
end;
Either way, when not mass-clearing Tree1 and ListaDeObjectos in one go, consider calling ListaDeObjectos.Remove() in the TTreeView.OnDeletion event to keep Tree1 and ListaDeObjectos in sync when removing individual nodes:
procedure TForm1.Tree1Deletion(Sender: TObject; Node: TNode);
begin
if Assigned(Node.Data) then
begin
// only if the TreeView is the owner...
Dispose(PMyRec(Node.Data));
ListaDeObjectos.Remove(Node.Data);
end;
end;
1. Whenever you do Dispose() your record instance, make sure you type-cast raw pointers to PMyRec or else the compiler will not finalize the record's members correctly, leaking memory.
I want to create a list of thread and change the number of running threads each interval of time ( depending on some condition), which is not possible using array of THandle because - as you know - here I need to fix the length of the array before creating threads, this is how I proceed:
procedure MainThread.execute;
var
HandleThread : THandle;
ListOfThreadsH : TList;
begin
ListOfThreadsH := TList.create;
while (condition) do
begin
HandleThread := TMyThread.Create( parameter1,..,parametern).Handle;
ListOfThreadsH.add (HandleThread);
ThreadCount := ThreadCount + 1;
end;
waitForMultipleObjects(ThreadCount, pointer(ListOfThreadsH), True, INFINITE);
end;
But, I'm having some issues with this:
Incompatible types pointer and cardinal in : ListOfThreadsH.add (HandleThread);, I can understand why I'm getting this but don't really know how to solve it.
Is it correct to wait for threads this way? Because as I know ListOfThreadsH type must be array of THandle. If not, how to wait for threads in this case?
If this is not the correct way to increment the number of running threads, then how to proceed? Thanks for your replies.
array of ... is dynamic, you can change its size at any time, eg:
procedure MainThread.execute;
var
ListOfThreads : TObjectList;
ArrOfHandles : array of THandle;
Thread : TMyThread;
begin
ListOfThreads := TObjectList.Create(True);
try
while (condition) do
begin
Thread := TMyThread.Create(...);
ListOfThreads.Add(Thread);
SetLength(ArrOfHandles, Length(ArrOfHandles) + 1);
ArrOfHandles[High(ArrOfHandles)] := Thread.Handle;
end;
WaitForMultipleObjects(Length(ArrOfHandles), PWOHandleArray(Pointer(ArrOfHandles)), True, INFINITE);
finally
ListOfThreads.Free;
end;
end;
Alternatively:
procedure MainThread.execute;
var
ListOfThreads : TObjectList;
ListOfHandles : TList<THandle>;
Thread : TMyThread;
begin
ListOfThreads := TObjectList.Create(True);
try
ListOfHandles := TList<THandle>.Create;
try
while (condition) do
begin
Thread := TMyThread.Create(...);
ListOfThreads.Add(Thread);
ListOfHandles.Add(Thread.Handle);
end;
WaitForMultipleObjects(ListOfHandles.Count, PWOHandleArray(Pointer(ListOfHandles.ToArray)), True, INFINITE);
finally
ListOfHandles.Free;
end;
finally
ListOfThreads.Free;
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 a Win32 Thread (no TThread) that runs alle the time and iterates over a static array. The mainthread can modify fields of the array. What is the best way to make this thread-safe without components like TThreadList (for a no-vcl application), only with Windows Critical Sections (TRTLCriticalSection)?
Code:
type
T = record
Idx: Integer;
Str: string;
Num: Real;
Enabled: Boolean;
end;
var
A: Array[0..9] of T;
Cnt: Integer;
CS: TRTLCriticalSection;
procedure thread;
var
I: Integer;
begin
while True do
begin
for I := Low(A) to High(A) do
begin
if A[I].Enabled then
begin
//modify some fields from A[I]
Inc(A[I].Idx);
if A[I].Idx >= 10 then
begin
A[I].Enabled := False;
InterlockedDecrement(Cnt);
end;
end;
end;
if Cnt = 0 then Sleep(1);
end;
end;
procedure Add(...); //called only from mainthread
function GetFreeField: Integer;
begin
for Result := Low(A) to High(A) do
if not A[Result].Enabled then Exit;
Result := -1;
end;
var
I: Integer;
begin
I := GetFreeField;
if I = -1 then Exit;
//set fields A[I]
A[I].Enabled := True;
InterlockedIncrement(Cnt);
end;
At the beginning the array is initialized with enabled = false and cnt = 0.
Is the following modification sufficient?
procedure thread;
var
I: Integer;
begin
while True do
begin
for I := Low(A) to High(A) do
begin
EnterCriticalSection(CS);
if A[I].Enabled then
begin
LeaveCriticalSection(CS);
//modify some fields from A[I]
Inc(A[I].Idx);
if A[I].Idx >= 10 then
begin
EnterCriticalSection(CS);
A[I].Enabled := False;
LeaveCriticalSection(CS);
InterlockedDecrement(Cnt);
end;
end
else
LeaveCriticalSection(CS);
end;
if Cnt = 0 then Sleep(1);
end;
end;
procedure Add(...); //called only from mainthread
var
I: Integer;
begin
I := GetFreeField;
if I = -1 then Exit;
//set fields A[I]
EnterCriticalSection(CS);
A[I].Enabled := True;
LeaveCriticalSection(CS);
InterlockedIncrement(Cnt);
end;
It looks to me as though your design is that:
The main thread only ever switches the Enabled flag from False to True.
The worker thread only ever switches the flag in the opposite direction.
No code other than what we see here accesses the array.
If that is true, the original code without the critical section is already thread safe. At least it is on hardware that uses a strong memory model. For example the Intel x86 or x64 architectures. The Enabled boolean acts as a synchronisation barrier between the threads.
However, your entire design looks flawed to me. The while True loop and the Sleep causes me some alarm. That thread is going run repeatedly for no good reason. Surely you should only be executing the code in the thread when the main thread has made modifications to the array. I'd prefer the use of a signal (for example a Windows event) to wake up the thread.