Hello I like to know how can I delay a work (or a command) for a specified time in Inno Setup Pascal Script.
The built in Sleep(const Milliseconds: LongInt) freezes all work while sleeping.
And the following function I implemented also makes the WizardForm unresponsive but not freezing like built in Sleep() Function.
procedure SleepEx(const MilliSeconds: LongInt);
begin
ShellExec('Open', 'Timeout.exe', '/T ' + IntToStr(MilliSeconds div 1000), '', SW_HIDE,
ewWaitUntilTerminated, ErrorCode);
end;
I also read this, but can't think how to use it in my function.
I like to know how can I use WaitForSingleObject in this SleepEx function.
Thanks in advance for your help.
Use a custom progress page (the CreateOutputProgressPage function):
procedure CurStepChanged(CurStep: TSetupStep);
var
ProgressPage: TOutputProgressWizardPage;
I, Step, Wait: Integer;
begin
if CurStep = ssPostInstall then
begin
// start your asynchronous process here
Wait := 5000;
Step := 100; // smaller the step is, more responsive the window will be
ProgressPage :=
CreateOutputProgressPage(
WizardForm.PageNameLabel.Caption, WizardForm.PageDescriptionLabel.Caption);
ProgressPage.SetText('Doing something...', '');
ProgressPage.SetProgress(0, Wait);
ProgressPage.Show;
try
// instead of a fixed-length loop,
// query your asynchronous process completion/state
for I := 0 to Wait div Step do
begin
// pumps a window message queue as a side effect,
// what prevents the freezing
ProgressPage.SetProgress(I * Step, Wait);
Sleep(Step);
end;
finally
ProgressPage.Hide;
ProgressPage.Free;
end;
end;
end;
The key point here is, that the SetProgress call pumps a window message queue, what prevents the freezing.
Though actually, you do not want the fixed-length loop, instead use an indeterminate progress bar and query the DLL in the loop for its status.
For that, see Inno Setup: Marquee style progress bar for lengthy synchronous operation in C# DLL.
Related
I have a thread that loops performing work and sleeping via an event for a good bit of time (several seconds.) The user can terminate the app while the thread is asleep waiting on the event. What actually happens to the event in that case? Does the thread keep running until the event times out, delaying the full termination of the app? Or does it return immediately with a return value other than timeout?
While it is not impossible to start processes that outlive the Delphi app that created them, threads created and started in the usual manner (via TThread.Create) end as soon as the main thread ends, without waiting for a cycle to complete and without holding up the termination of the main app.
To convince yourself of this, create a Delphi app and a thread that is started by clicking a button. Have the thread write to a file, then sleep for an arbitrarily large amount of time. When you're sure it's asleep, kill the app. Note that the app terminates immediately, and also the thread is "killed in its sleep".
In fact, if we add a finalization section:
type
TTThread = class(TThread)
msg : string;
ctr : Integer;
public procedure Execute; override;
procedure Update;
end;
procedure TTThread.Execute;
var F: TextFile;
begin
ctr := 0;
assignFile(F, 'log.txt');
rewrite(f);
closefile(f);
while not Terminated do
begin
inc(ctr);
msg := 'Updating';
Synchronize(Update);
assignFile(F, 'log.txt');
append(f);
writeln(F, IntToStr(Ctr));
closefile(f);
msg := 'Sleeping';
Synchronize(Update);
Sleep(3000);
end;
end;
procedure TTThread.Update;
begin
Form1.Caption := '**********'+msg+IntToStr(ctr)+'******************';
end;
var T: TTThread;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not assigned(T) then T := TTThread.Create(false);
end;
var F: TextFile;
initialization
finalization
assignFile(F, 'log.txt');
append(f);
writeln(F, 'Application out!');
closefile(f);
end.
(N.B. this is not presented as thread-safe code but it is useful for experimentation.)
You can set your debugger at the last closeFile in the finalization and park it there as long as you like and the thread will not write to the file again. This tells us that by the time the finalization code hits, owned threads are already dead.
Depending on your level of interest, you can also check in the OnClose of the form, override the Close method for your main form, etc.
This leaves some holes in our understanding, like whether the main form formally terminates each thread, but I trust from this you can figure out how you would test that. (A quick scan of the Form source was not especially revealing.)
Background: I need to perform checks whether a bunch of network drives or remote computers are available. Since each DirectoryExists() needs a lot of time until a potential timeout, I perform the checks in separate threads. It can happen, that an end-user closes the application while some of the checks are still running. Since DirectoryExists() blocks, I have no chance of using the classical while not Terminated approach.
procedure TMyThread.Execute;
begin
AExists := DirectoryExists(AFilepath);
end;
Question 1: Is it a problem that some threads are still running when the application quits? Will Windows simply tidy up after me and that's it? Inside the IDE I get notification of un-freed objects, but outside IDE it just appears to be peaceful.
Question 2: Is it possible to terminate such simple threads with TerminateThread or is this potentially harmful in THIS case?
Question 3: I usually take the results from the threads in OnTerminate() event and let the threads FreeOnTerminate afterwards. If I wanted to free them myself, when should I do it? Can I free a thread in its OnTerminate event or is this a tiny bit too early? How would a thread inform me that it is done if not with OnTerminate?
Is it a problem that some threads are still running when the application quits?
Possibly, yes. It depends on what your code does after DirectoryExists() exits. You might end up trying to access things that no longer exist.
Will Windows simply tidy up after me and that's it?
To ensure everything is cleaned up properly, you are responsible for terminating your own threads. When the main VCL thread is done running, it will call ExitProcess(), which will forcibly terminate any secondary threads that are still running, which will not allow them to clean up after themselves, or notify any loaded DLLs that they are being detached from the threads.
Is it possible to terminate such simple threads with TerminateThread or is this potentially harmful in THIS case?
TerminateThread() is ALWAYS potentially harmful. NEVER use it.
I usually take the results from the Threads in OnTerminate() event and let the threads FreeOnTerminate afterwards.
That will not work if the main message loop has exited before the thread terminates. By default, the TThread.OnTerminate event is fired via a call to TThread.Synchronize(). Once the main message loop stops running, there won't be anything to process the pending Synchronize() requests, unless you run your own loop at app exit to call the RTL's CheckSynchronize() procedure until all of your threads have fully terminated.
if I wanted to free them myself, when should I do it?
Before your app wants to exit.
Can I free a thread in its OnTerminate event
No.
or is this a tiny bit too early?
That, and because it is always unsafe to free an object inside an event fired by that same object. The RTL still needs access to the object after the event handler exits.
That being said, since you don't have a clean way to terminate the threads safely, I suggest NOT allowing your app to exit when there are threads still running. When the user requests the app to exit, check if there are threads running, and if so then display a busy UI to the user, wait for all of the threads to terminate, and then exit the app.
For example:
constructor TMyThread.Create(...);
begin
inherited Create(False);
FreeOnTerminate := True;
...
end;
procedure TMyThread.Execute;
begin
...
if Terminated then Exit;
AExists := DirectoryExists(AFilepath);
if Terminated then Exit;
...
end;
type
TMainForm = class(TForm)
...
procedure FormClose(Sender: TObject; var Action: TCloseAction);
...
private
ThreadsRunning: Integer;
procedure StartAThread;
procedure ThreadTerminated(Sender: TObject);
...
end;
...
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ThreadsRunning = 0 then Exit;
// signal threads to terminate themselves...
if CheckWin32Version(6) then
ShutdownBlockReasonCreate(Handle, 'Waiting for Threads to Terminate');
try
// display busy UI to user ...
repeat
case MsgWaitForMultipleObjects(1, System.Classes.SyncEvent, False, INFINITE, QS_ALLINPUT) of
WAIT_OBJECT_0 : CheckSynchronize;
WAIT_OBJECT_0+1 : Application.ProcessMessages;
WAIT_FAILED : RaiseLastOSError;
end;
until ThreadsRunning = 0;
// hide busy UI ...
finally
if CheckWin32Version(6) then
ShutdownBlockReasonDestroy(Handle);
end;
end;
procedure TMainForm.StartAThread;
var
Thread: TMyThread;
begin
Thread := TMyThread.Create(...);
Thread.OnTerminate := ThreadTerminated;
Thread.Start;
Inc(ThreadsRunning);
end;
procedure TMainForm.ThreadTerminated(Sender: TObject);
begin
Dec(ThreadsRunning);
...
end;
Alternatively:
type
TMainForm = class(TForm)
...
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
...
private
ThreadsRunning: Integer;
WaitingForClose: Boolean;
procedure StartAThread;
procedure ThreadTerminated(Sender: TObject);
...
end;
...
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := (ThreadsRunning = 0);
if CanClose or WaitingForClose then Exit;
// signal threads to terminate themselves...
WaitingForClose := True;
// display busy UI to user ...
if CheckWin32Version(6) then
ShutdownBlockReasonCreate(Handle, 'Waiting for Threads to Terminate');
end;
procedure TMainForm.StartAThread;
var
Thread: TMyThread;
begin
Thread := TMyThread.Create(...);
Thread.OnTerminate := ThreadTerminated;
Thread.Start;
Inc(ThreadsRunning);
end;
procedure TMainForm.ThreadTerminated(Sender: TObject);
begin
Dec(ThreadsRunning);
...
if WaitingForClose and (ThreadsRunning = 0) then
begin
WaitingForClose := False;
// hide busy UI ...
if CheckWin32Version(6) then
ShutdownBlockReasonDestroy(Handle);
Close;
end;
end;
Is it a problem that some threads are still running when the application quits?
When taken literally, this question is a little bit malformed. That is because after ExitProcess is called, which is how a Delphi application is ended by default, no threads are running.
The answer to the question "is it a problem that some threads didn't have a chance to finish" depends on what these threads failed to complete. You would have to carefully analyze thread code, but generally speaking this might be prone to errors.
Will Windows simply tidy up after me and that's it? Inside the IDE I get notification of un-freed objects, but outside IDE it just appears
to be peaceful.
The OS will reclaim allocated memory when the process address space is destroyed, all object handles will be closed when the process handle table is destroyed, entry points of all loaded libraries will be called with DLL_PROCESS_DETACH. I can't find any documentation on this but I also presume pending IO requests would be called to cancel.
But all of this does not mean there won't be any problems. Things can get messy, for instance, involving interprocess communications or synchronization objects. Documentation for ExitProcess details one such example: if a thread vanishes before releasing a lock that one of the libraries tries to acquire while detaching, there's a deadlock. This blog post gives another specific example where the exiting process is forcibly terminated by the OS if a thread attempts to enter a critical section that is orphaned by another already terminated thread.
While it may make sense to let go of resource releasing at exit time, particularly if cleanup is taking a considerable amount of time, it is possible to get it wrong for a non-trivial application. A robust strategy is to clean up everything before ExitProcess is called. OTOH if you find yourself in a situation where ExitProcess is already called, such as the process is detaching from your dll because of termination, the nearly only safe thing to do is to leave everything behind and return - every other dll could have already been unloaded and every other thread terminated.
Is it possible to terminate such simple threads with TerminateThread or is this potentially harmful in THIS case?
TerminateThread is advised to be used only in most extreme cases but since the question has a bold "THIS" what the code really does should be examined. Looking at the RTL code we can see that the worst that can happen is leaving a file handle open which is accessed for reading only. THIS is not a problem at process termination time since the handle will be closed shortly.
I usually take the results from the threads in OnTerminate() event and let the threads FreeOnTerminate afterwards. If I wanted to free
them myself, when should I do it?
The only strict rule is after they are finished executing. The choice would probably be guided by the design of the application. What would be different is, you wouldn't be able to use FreeOnTerminate and you would keep references to your threads to be able to free them. In the test case I worked on for answering this question, the worker threads which are finished are freed when a timer fires, kind of like a garbage collector.
Can I free a thread in its OnTerminate event or is this a tiny bit too early?
Freeing an object in one of its own event handlers induces a risk of operating on freed instance memory. The documentation specifically warns against this for components but in general this is applicable to all classes.
Even if you'd want to disregard the warning, this is a deadlock. Although the handler is called after Execute returns, OnTerminate is still synchronized from the ThreadProc. If you attempt to free the thread in the handler, it will cause a wait from the main thread for the thread to finish - which is waiting for the main thread to return from OnTerminate, which is a deadlock.
How would a thread inform me that it is done if not with OnTerminate?
OnTerminate is fine for informing that a thread has done its job, although you can use other means like using synchronization objects or queuing a procedure or posting a message etc.. Also worth noting that it's possible to wait on a thread handle, which is what TThread.WaitFor does.
In my test program I tried to determine application termination time depending on various exit strategies. All test results are dependent on my testing environment.
Termination time is measured starting from when the OnClose handler of a VCL form is called and ending with just before ExitProcess is called by the RTL. Also, this method does not account for how long ExitProcess takes, which I presume would be different when there are dangling threads. But I didn't try to measure it anyway.
Worker threads query the existence of a directory on a non-existing host. This is the most I could come up on waiting time. Every query is on a new non-existing host, otherwise DirectoryExists returns immediately.
A timer starts and collects worker threads. Depending on the time the IO query takes (which is around 550ms) the timer interval effects the total count of threads at any given time. I tested on around 10 threads with a timer interval of 250ms.
Various debug outputs allow to follow the flow in the event log of the IDE.
My first test was to leave the worker threads behind - just quit the application. The time I measured was 30-65ms. Again, this could have caused ExitProcess itself to take longer.
Next, I tested terminating the threads with TerminateThread. This took 140-160ms. I believe this is actually closer to what the previous test would come up if the time ExitProcess takes could be accounted for. But I have no proof on that.
Next, I tested cancelling the IO request on running threads and then leaving them behind.This considerably decreased the amount of leaked memory, in fact completely eliminated in most of the runs. Although the cancellation request is asynchronous, nearly all of the threads return immediately and find the time to finish. Anyway, this took 160-190ms.
I should note here that the code in DirectoryExists is defective, at least in XE2. The first thing the function does is to call GetFileAttributes. An INVALID_FILE_ATTRIBUTES return denotes the function failed. This is how the RTL handles the fail:
function DirectoryExists(const Directory: string; FollowLink: Boolean = True): Boolean;
...
...
Result := False;
Code := GetFileAttributes(PChar(Directory));
if Code <> INVALID_FILE_ATTRIBUTES then
begin
...
end
else
begin
LastError := GetLastError;
Result := (LastError <> ERROR_FILE_NOT_FOUND) and
(LastError <> ERROR_PATH_NOT_FOUND) and
(LastError <> ERROR_INVALID_NAME) and
(LastError <> ERROR_BAD_NETPATH);
end;
end;
This code assumes that unless GetLastError returns one of the above error codes the directory exists. This reasoning is flawed. Indeed, when you cancel the IO request, GetLastError returns ERROR_OPERATION_ABORTED (995) as documented but DirectoryExists returns true whether the directory exists or not.
Waiting for the threads to finish without cancelling IO takes 330-530ms. This completely eliminates memory leaks.
Cancelling IO requests and then waiting for the threads to finish takes 170-200ms. Of course no memory leaks here either. Considering there are no significant timing difference in any of the options, this would be the one I choose.
Testing code I used is below:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls,
generics.collections;
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
private
FThreads: TList<TThread>;
end;
var
Form1: TForm1;
implementation
uses
diagnostics;
{$R *.dfm}
type
TIOThread = class(TThread)
private
FTarget: string;
protected
constructor Create(Directory: string);
procedure Execute; override;
public
destructor Destroy; override;
end;
constructor TIOThread.Create(Directory: string);
begin
FTarget := Directory;
inherited Create;
end;
destructor TIOThread.Destroy;
begin
inherited;
OutputDebugString(PChar(Format('Thread %d destroyed', [ThreadID])));
end;
procedure TIOThread.Execute;
var
Watch: TStopwatch;
begin
OutputDebugString(PChar(Format('Thread Id: %d executing', [ThreadID])));
Watch := TStopwatch.StartNew;
ReturnValue := Ord(DirectoryExists(FTarget));
Watch.Stop;
OutputDebugString(PChar(Format('Thread Id: %d elapsed time: %dms, return: %d',
[ThreadID, Watch.Elapsed.Milliseconds, ReturnValue])));
end;
//-----------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
FThreads := TList<TThread>.Create;
Timer1.Interval := 250;
Timer1.Enabled := True;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FThreads.Free;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
ShareName: array [0..12] of Char;
i: Integer;
H: THandle;
begin
for i := FThreads.Count - 1 downto 0 do
if FThreads[i].Finished then begin
FThreads[i].Free;
FThreads.Delete(i);
end;
for i := Low(ShareName) to High(ShareName) do
ShareName[i] := Chr(65 + Random(26));
FThreads.Add(TIOThread.Create(Format('\\%s\share', [string(ShareName)])));
OutputDebugString(PChar(Format('Possible thread count: %d', [FThreads.Count])));
end;
var
ExitWatch: TStopwatch;
// not declared in XE2
function CancelSynchronousIo(hThread: THandle): Bool; stdcall; external kernel32;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
i: Integer;
Handles: TArray<THandle>;
IOPending: Bool;
Ret: DWORD;
begin
ExitWatch := TStopwatch.StartNew;
// Exit;
Timer1.Enabled := False;
{
for i := 0 to FThreads.Count - 1 do
TerminateThread(FThreads[i].Handle, 0);
Exit;
//}
if FThreads.Count > 0 then begin
SetLength(Handles, FThreads.Count);
for i := 0 to FThreads.Count - 1 do
Handles[i] := FThreads[i].Handle;
//{
OutputDebugString(PChar(Format('Cancelling at most %d threads', [Length(Handles)])));
for i := 0 to Length(Handles) - 1 do
if GetThreadIOPendingFlag(Handles[i], IOPending) and IOPending then
CancelSynchronousIo(Handles[i]);
//}
//{
Assert(FThreads.Count <= MAXIMUM_WAIT_OBJECTS);
OutputDebugString(PChar(Format('Will wait on %d threads', [FThreads.Count])));
Ret := WaitForMultipleObjects(Length(Handles), #Handles[0], True, INFINITE);
case Ret of
WAIT_OBJECT_0: OutputDebugString('wait success');
WAIT_FAILED: OutputDebugString(PChar(SysErrorMessage(GetLastError)));
end;
//}
for i := 0 to FThreads.Count - 1 do
FThreads[i].Free;
end;
end;
procedure Exiting;
begin
ExitWatch.Stop;
OutputDebugString(PChar(
Format('Total exit time:%d', [ExitWatch.Elapsed.Milliseconds])));
end;
initialization
ReportMemoryLeaksOnShutdown := True;
ExitProcessProc := Exiting;
end.
New here. Relatively new to Delphi as well so plz be kind...
My actual (domain) problem: small VCL app that communicates with two laboratory balances via serial, balances output weight readings on a continuous 1-second interval, said weighs are displayed in the captions of two labels. When user clicks a 'Weigh' button, I need to wait for a valid weight (stable, within range, etc.) and record said weight once, -or-, allow the user to cancel the weighing.
My problem as implemented. Creating a separate thread when user clicks weigh button using TEvent template from S.MAHDI / David Heffernan as shown in this post.
TWeigh = class(TThread)
private
FTerminateEvent: TEvent;
protected
procedure Execute; override;
procedure TerminatedSet; override;
public
constructor Create(ACreateSuspended: Boolean);
destructor Destroy; override;
end;
constructor TWeigh.Create(ACreateSuspended: Boolean);
begin
FTerminateEvent := TEvent.Create(nil, True, False, '');
inherited;
end;
destructor TWeigh.Destroy;
begin
inherited;
FTerminateEvent.Free;
end;
procedure TWeigh.TerminatedSet;
begin
FTerminateEvent.SetEvent;
Beep;
end;
procedure TWeigh.Execute();
begin
while (not Terminated) do begin
if (validweight) then begin
Synchronize(procedure begin
DoStuff();
end);
end;
FTerminateEvent.WaitFor(100);
end;
end;
My form button click event looks like:
{ Weigh is global implementation var of class TWeigh }
procedure TForm1.btnWeighClick(Sender: TObject);
var
B : TButton;
begin
B := Sender as TButton;
if (B.Caption = 'Weigh') then Weigh := TWeigh.Create(False);
if (B.Caption = 'Cancel') then Weigh.Free;
B.Caption := Trim(Copy('CancelWeigh ',AnsiPos(B.Caption,'Weigh Cancel'),6));
end;
This appears to work fine for the cancellation requirement. It's my understanding that Synchronize messages the main thread and it is the main thread that executes the anonymous procedure containing DoStuff(), so there should be no race conditions between the user clicking cancel and a valid weight coming in. (Right?)
I'm stuck on how to have the weigh thread only execute a single time. Various solutions I've tried have resulted in deadlocks (add Weigh.Free to DoStuff()... didn't take long to figure out why THAT doesn't work), single execution but non-free'd threads (self.Terminate after the synchronize section within the if block), or various other nonsense.
So, is it even possible to have this thread free and/or kill itself while still allowing for the parent thread via user input to kill it, or do I need a completely different architecture for this?
Edit in response to why a loop: I only need a single reading, but the time until I get that single reading varies between immediately and never. The balances can take several seconds to stabilize, during which time unstable readings are read and displayed every second. The ability for the user to cancel is still required because the reading might never be valid (under-overweight).
If I understand correctly, you wish to quit the thread when you've finished calling DoStuff. That can be done like so:
procedure TWeigh.Execute();
begin
while (not Terminated) do begin
if (validweight) then begin
Synchronize(procedure begin
DoStuff();
end);
exit;
end;
FTerminateEvent.WaitFor(100);
end;
end;
I have to say that this looks more appropriate for a timer than a thread. All the work is done on the main thread, and the thread just appears to be there to check a flag at a regular interval. That sounds like a timer. In fact, why even a timer? Why not fire the DoStuff when you set the flag true?
I am trying to make an infinite loop but I want the loop to run every 30 seconds. The loop will start. A bunch of if statements take place and some information will be changed. The loop must then pause for 30 seconds and then the loop will start again. This must continue forever.
I am looking for a way to pause the loop for 30 seconds and then continue. Any good advice will be appreciated.
EDIT #1
The program shows "special" information based on date and time: As the time changes the information changes: 06:00 = math; 07:30 = biology. The program also shows you the time left until the next class starts. Thus the program needs to run continuously to update the time so that it knows exactly what period it is and how much time is left until the next period.
EDIT #2
I want put in a "refresh" so that script I want the script to be called on a set interval so that it is not running constantly and eating the ram. This interval must be 30 seconds.
Based on your update that provides more details I think I would use a single thread with a timer to provide a pulse to drive updates.
Set the timer interval to be whatever rate you wish updates to the GUI to occur at. For instance, perhaps a refresh rate of twice a minute is what you want, in which case set the timer interval to 30*1000.
Whenever the timer fires, use the current system time to work out the information that you need to display, and then display that information.
Note that this answer does not tell you how to wait 30 seconds and continue. However, I suspect that this is the easiest solution to your actual problem.
You don't want to block your program because that would stop the UI being responsive. It would stop you being able to interact with the UI and stop the UI from being able to paint itself. In a GUI program you must not block in the main thread. You should only block in background threads. But threads add complexity that is just needless. You don't want to block. You don't want to wait. You just need a regular pulse to drive updates. A timer.
If you have code that blocks the GUI, you can use a background thread and an event to provide a non blocking timer.
Create a new Forms application and put a TMemo component on your form.
This example will add a new line with the current time to your TMemo.
Main form:
unit u_frm_main;
interface
uses
u_workthread,
SysUtils,
Windows,
Forms,
SyncObjs, Classes, Controls, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
Worker : TWorkThread;
procedure ShowData;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ShowData;
begin
// do whatever you need to do here...
// show current time in memo
Memo1.Lines.Add(FormatDateTime('HH:NN:SS', Now));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// create our worker thread and start it
Worker := TWorkThread.Create(3, ShowData);
Worker.Start;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// signal our worker thread that we are done here
Worker.ThreadEvent.SetEvent;
// terminate and wait
Worker.Terminate;
Worker.WaitFor;
end;
end.
Worker Thread:
unit u_workthread;
interface
uses
SysUtils,
SyncObjs,
Classes;
type
TWorkProc = procedure of object;
TWorkThread = class(TThread)
private
{ Private declarations }
Counter : Integer;
FTimeout : Integer;
FEventProc: TWorkProc;
procedure DoWork;
protected
procedure Execute; override;
public
ThreadEvent : TEvent;
constructor Create(TimeoutSeconds : Integer; EventProc: TWorkProc ); // timeout in seconds
destructor Destroy; override;
end;
implementation
procedure TWorkThread.DoWork;
begin
// put your GUI blocking code in here. Make sure you never call GUI elements from this procedure
//DoSomeLongCalculation();
end;
procedure TWorkThread.Execute;
begin
Counter := 0;
while not Terminated do
begin
if ThreadEvent.WaitFor(FTimeout) = wrTimeout then
begin
DoWork;
// now inform our main Thread that we have data
Synchronize(FEventProc);
end;
else
// ThreadEvent has been signaled, exit our loop
Break;
end;
end;
constructor TWorkThread.Create(TimeoutSeconds : Integer; EventProc: TWorkProc);
begin
ThreadEvent := TEvent.Create(nil, True, False, '');
// Convert to milliseconds
FTimeout := TimeoutSeconds * 1000;
FEventProc:= EventProc;
// call inherited constructor with CreateSuspended as True
inherited Create(True);
end;
destructor TWorkThread.Destroy;
begin
ThreadEvent.Free;
inherited;
end;
end.
I am in a multi-threaded situation and I have a function that I want to be run from only one thread at a time. However, rather than serializing the function in the tradition manner, I want any threads that attempt to enter the function whilst the first thread is running it to return immediately. I do not want the second thread to wait for the first thread.
Here is my code:
function InitMutex(const Name:String; var Handle: THandle):Boolean;
begin
Handle := CreateMutexA(NIL, True, PAnsiChar(Name));
Result := not (GetLastError = ERROR_ALREADY_EXISTS);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
mHandle: THandle;
begin
if not InitMutex(BalloonTipMutex, mHandle) then Exit;
MessageBox(0, 'Executing Code....', '', 0);
ReleaseMutex(mHandle);
CloseHandle(mHandle);
end;
This is just an example with the same problem, cause I couldn't do a test sample with the threads.
The problem is: I click button1 for the first time, The messagebox appears, while the messagebox is still displayed (suppose the function is still running) I press button1 again, nothing is displayed (which is what's supposed to happen) but when I close the message box and press the button again, it shows nothing. (the function supposed to run again since its not running :S)
Try this instead:
procedure TForm1.Button1Click(Sender: TObject);
var mHandle: THandle;
begin
mHandle := 0;
if InitMutex(BalloonTipMutex, mHandle) then
begin
MessageBox(0, 'Executing Code....', '', 0);
ReleaseMutex(mHandle);
end;
if handle <> 0 then
CloseHandle(mHandle);
end;
your problem is... Even if CreateMutex returns error ERROR_ALREADY_EXISTS, it did "open" the mutex. So when your first function exit, the mutex is not freed since your 2nd call opened it, but never closed it. So when you try to call your function a 3rd time, it fails not because your first call kept the mutex open, but because your 2nd call did.
Also, I think InitMutex should return Result := (Handle <> 0) and not (GetLastError = ERROR_ALREADY_EXISTS)
EDIT: On a side note, this isn't really the way mutex are meant to be used. The "traditional" way to use mutex is to create them, then have your thread try to get ownership of them when you want to execute the code protected by the mutex. I would expect CreateMutex to be quite a bit slower than just taking ownership of a mutex and maybe there are some other pitfalls to that technique.
Now that I finally understand the question, I believe that the most efficient solution is to use interlocked operations.
procedure OneAtATimeThroughHere;
//FLockCount is a properly aligned integer, shared between all threads
var
ThisLockCount: Integer;
begin
ThisLockCount := InterlockedIncrement(FLockCount);
try
if ThisLockCount=1 then//we won the race
begin
//do stuff
end;
finally
InterlockedDecrement(FLockCount);
end;
end;
This approach will not permit re-entrant calls. If you need to cater for re-entrant calls then the solution is to use TryEnterCriticalSection(). Critical sections are much easier to use than mutexes, and they are faster too. Delphi wraps up the critical section API in the TCriticalSection object in the SyncObjs unit.
So your code would look like this:
procedure OneAtATimeThroughHere;
//FLock is an instance of TCriticalSection shared between all threads
if FLock.TryEnter then
begin
try
//do stuff
finally
FLock.Release;
end;
end;
As an alternate solution, you could use the AddAtom(), FindAtom() and DeleteAtom() Windows API functions (see: http://msdn.microsoft.com/en-us/library/ms649056(v=vs.85).aspx). There are also global versions of these for use between processes.
Using atoms would allow you to maintain full control over the flow of your threads and contain the entire locking mechanism within the function (like you could with a critical section).
You should create the mutex once and hold on to it for as long as your threads are running, and then have the function use WaitForSingleObject() with a timeout of 0 milliseconds to try to acquire the mutex lock. If WaitForSingleObject() returns WAIT_OBJECT_0, then the function was not already running yet.
var
mHandle: THandle = 0;
procedure TForm1.FormCreate(Sender: TObject);
begin
mHandle := CreateMutex(nil, False, nil);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CloseHandle(mHandle);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if WaitForSingleObject(mHandle, 0) = WAIT_OBJECT_0 then
begin
try
MessageBox(0, 'Executing Code....', '', 0);
finally
ReleaseMutex(mHandle);
end;
end;
end;