In the following test program each test thread adds its handle to a global TThreadList when it starts executing, and removes its handle from the same list when its execution is about to end.
For testing purposes, additionally, each thread makes sure it adds its handle before the main thread locks the list (to duplicate their handles and start waiting on them to finish). The threads also make sure they don't remove their handles before the main thread locks the list.
The test program runs fine for about up to 50-60 threads. After that, the WaitForMultipleObjects call start to fail with WAIT_FAILED, GetLastError returns 87 (ERROR_INVALID_PARAMETER). Currently it starts 100 threads. My question is, what am I doing wrong?
The program is compiled with XE2 - update 4, 32-bit target platform. Test box is W7x64.
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
windows,
sysutils,
classes,
syncobjs;
type
TTestThread = class(TThread)
private
FAckStarted: TEvent;
function GetAckHandle: THandle;
class var
ThreadList: TThreadList;
WaitEnd: THandle;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
property AckHandle: THandle read GetAckHandle;
end;
{.$DEFINE FREEONTERMINATE}
constructor TTestThread.Create;
begin
inherited Create(True);
FAckStarted := TEvent.Create;
{$IFDEF FREEONTERMINATE}
FreeOnTerminate := True;
{$ENDIF}
end;
destructor TTestThread.Destroy;
begin
FAckStarted.Free;
inherited;
end;
procedure TTestThread.Execute;
begin
// OutputDebugString(PChar(Format('%d starting -------------', [Handle])));
ThreadList.Add(Pointer(Handle));
FAckStarted.SetEvent;
NameThreadForDebugging(AnsiString(IntToStr(Handle)));
WaitForSingleObject(WaitEnd, INFINITE);
ThreadList.Remove(Pointer(Handle));
// OutputDebugString(PChar(Format('%d leaving -------------', [Handle])));
end;
function TTestThread.GetAckHandle: THandle;
begin
Result := FAckStarted.Handle;
end;
const
NumThreads = 100;
var
DeferThreadEnd: TEvent;
ThreadList: array of TThread;
i: Integer;
Thread: TTestThread;
WaitThreadStart: THandle;
LockList: TList;
LockListCount: Integer;
ThreadHandleArr: array of THandle;
WaitRet: DWORD;
begin
IsMultiThread := True;
ReportMemoryLeaksOnShutdown := True;
TTestThread.ThreadList := TThreadList.Create;
DeferThreadEnd := TEvent.Create;
TTestThread.WaitEnd := DeferThreadEnd.Handle;
SetLength(ThreadList, NumThreads);
for i := 0 to NumThreads - 1 do begin
Thread := TTestThread.Create;
ThreadList[i] := Thread;
WaitThreadStart := Thread.GetAckHandle;
Thread.Start;
WaitForSingleObject(WaitThreadStart, INFINITE);
end;
LockList := TTestThread.ThreadList.LockList;
LockListCount := LockList.Count;
SetLength(ThreadHandleArr, LockListCount);
for i := 0 to LockListCount - 1 do
{$IFDEF FREEONTERMINATE}
Win32Check(DuplicateHandle(GetCurrentProcess, THandle(LockList[i]),
GetCurrentProcess, #ThreadHandleArr[i], SYNCHRONIZE, True, 0));
{$ELSE}
ThreadHandleArr[i] := THandle(LockList[i]);
{$ENDIF}
TTestThread.ThreadList.UnlockList;
DeferThreadEnd.SetEvent;
if LockListCount > 0 then begin
Writeln('waiting for ', LockListCount, ' threads');
WaitRet := WaitForMultipleObjects(LockListCount,
PWOHandleArray(ThreadHandleArr), True, INFINITE);
case WaitRet of
WAIT_OBJECT_0: Writeln('wait success');
WAIT_FAILED: Writeln('wait fail:', SysErrorMessage(GetLastError));
end;
end;
for i := 0 to Length(ThreadList) - 1 do begin
{$IFDEF FREEONTERMINATE}
Win32Check(CloseHandle(ThreadHandleArr[i]));
{$ELSE}
ThreadList[i].Free;
{$ENDIF}
end;
DeferThreadEnd.Free;
TTestThread.ThreadList.Free;
Writeln('program end');
Readln;
end.
The WaitForMultipleObjects() documentation states:
The maximum number of object handles is MAXIMUM_WAIT_OBJECTS.
The value of MAXIMUM_WAIT_OBJECTS is 64 (defined in winnt.h), so 100 handles is over the limit. However, the documentation also explains how to overcome that limit:
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.
See the answer to this question for an example of the first technique.
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.
I have a Delphi DLL, which needs to be called from my main UI application or worker threads.
I do not want to call LoadLibrary/FreeLibrary each time I call the DLL. But, I also don't want to load it in my application initialization section. because I might not use the DLL at all during the lifetime of the application.
So what I need is the first caller (thread or main UI) to initialize and load the DLL.
the DLL will be unloaded in the finalization section. I realize I need some synchronization. so I have used a critical section BUT I can't seem to make it work.
Only one thread should attempt and load the DLL. if it fails other threads should not attempt to load the DLL again and again.
The synchronization is not working as expected!
Can someone suggest why?
MCVE:
program Project1;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
Classes;
const
MyDLL = 'MyDLL.dll';
type
TDLLProcessProc = function(A: Integer): Integer; stdcall;
var
DLLProc: TDLLProcessProc = nil;
DLLModule: HMODULE = 0;
DLLInitialized: Boolean = False;
DLLInitialized_OK: Boolean = False;
CS: TRTLCriticalSection;
procedure InitDLLByFirstCall;
begin
if DLLModule = 0 then
begin
if DLLInitialized then Exit;
EnterCriticalSection(CS);
try
if DLLInitialized then Exit;
DLLInitialized := True;
DLLModule := LoadLibrary(MyDLL);
if DLLModule = 0 then RaiseLastWin32Error;
DLLProc := GetProcAddress(DLLModule, 'Process');
if #DLLProc = nil then RaiseLastWin32Error;
DLLInitialized_OK := True;
finally
LeaveCriticalSection(CS);
end;
end;
end;
function DLLProcess(A: Integer): Integer;
begin
InitDLLByFirstCall;
if not DLLInitialized_OK then
raise Exception.Create('DLL was not initialized OK');
Result := DLLProc(A);
end;
type
TDLLThread = class(TThread)
private
FNum: Integer;
public
constructor Create(CreateSuspended: Boolean; ANum: Integer);
procedure Execute; override;
end;
constructor TDLLThread.Create(CreateSuspended: Boolean; ANum: Integer);
begin
FreeOnTerminate := True;
FNum := ANum;
inherited Create(CreateSuspended);
end;
procedure TDLLThread.Execute;
var
RetValue: Integer;
begin
try
RetValue := DLLProcess(FNum);
Sleep(0);
Writeln('TDLLThread Result=> ' + IntToStr(RetValue));
except
on E: Exception do
begin
Writeln('TDLLThread Error: ' + E.Message);
end;
end;
end;
var
I: Integer;
begin
InitializeCriticalSection(CS);
try
// First 10 thread always fail!
for I := 1 to 10 do
TDLLThread.Create(False, I);
Readln;
for I := 1 to 10 do
TDLLThread.Create(False, I);
Readln;
finally
DeleteCriticalSection(CS);
end;
end.
DLL:
library MyDLL;
uses
Windows;
{$R *.res}
function Process(A: Integer): Integer; stdcall;
begin
Result := A;
end;
exports
Process;
begin
IsMultiThread := True;
end.
You need to modify your code in a way that the condition variable that is checked at the start of InitDLLByFirstCall is set only after all initialization has been completed. The DLL handle is therefore a bad choice.
Second you need to use the same condition variable outside and inside of the critical section - if you use DLLInitialized for that, then there is not really a use for either DLLInitialized_OK nor DLLModule.
And to make things easier to reason about you should try to get away with the minimum number of variables. Something like the following should work:
var
DLLProc: TDLLProcessProc = nil;
DLLInitialized: Boolean = False;
CS: TRTLCriticalSection;
procedure InitDLLByFirstCall;
var
DLLModule: HMODULE;
begin
if DLLInitialized then
Exit;
EnterCriticalSection(CS);
try
if not DLLInitialized then
try
DLLModule := LoadLibrary(MyDLL);
Win32Check(DLLModule <> 0);
DLLProc := GetProcAddress(DLLModule, 'Process');
Win32Check(Assigned(DLLProc));
finally
DLLInitialized := True;
end;
finally
LeaveCriticalSection(CS);
end;
end;
function DLLProcess(A: Integer): Integer;
begin
InitDLLByFirstCall;
if #DLLProc = nil then
raise Exception.Create('DLL was not initialized OK');
Result := DLLProc(A);
end;
If you don't want to check for the function address inside of DLLProcess then you could also use an integer or enumeration for the DLLInitialized variable, with different values for not initialized, failed and success.
You've got your double checked locking implemented incorrectly. You assign to DLLModule before assigning to DLLProc. So DLLModule can be non-zero whilst DLLProc is still null.
The variable that you test outside the lock must be modified after all the initialization is complete.
The pattern is like this:
if not Initialised then begin
Lock.Enter;
if not Initialised then begin
// Do initialisation
Initialised := True; // after initialisation complete
end;
Lock.Leave;
end;
Remember that double checked locking, as implemented here, only works because of the strong x86 memory model. If you ever move this code onto hardware with a weak memory model, it won't work as implemented. You'd need to implement barriers. Possible to do, but not entirely trivial.
Double checked locking is pointless here though. Remove it and protect everything with a single critical section. You are spinning up a thread, a very expensive task. The potential contention on a critical section is negligible.
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;