Delphi XE + thread + idHttp without memory leaks - multithreading

At first HI ALL and sry for my English.
can somebody share work source with create + destroy threads with simple GET in execute ?
i try do it by myself but always get memory leaks((
i test it with code at end of source
initialization
ReportMemoryLeaksOnShutdown := True;
btw ill Google it 2 week and test many samples... and always have leaks by default =(
delphi XE7 32bit at windows 7 x64
when i press stop button i still see some connections
after closing i get this message
cant post image, need 10 reputation...
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, sButton, sMemo, sEdit,
sSpinEdit, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,System.SyncObjs;
type
TForm1 = class(TForm)
StartBtn: TsButton;
StopBtn: TsButton;
ThreadCount: TsSpinEdit;
sdt1: TsEdit;
sm1: TsMemo;
procedure StartBtnClick(Sender: TObject);
procedure StopBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
Thread = class(TThread)
private
HTTP : TIdHTTP;
result:integer;
InputIndex:integer;
public
procedure Local;
constructor Create(CreateSuspended:boolean);
destructor Destroy; override;
protected
procedure Execute; override;
end;
var
Form1: TForm1;
LocalWork: Boolean;
target: string;
implementation
{$R *.dfm}
constructor Thread.Create(CreateSuspended: boolean);
begin
Inherited Create(true);
FreeOnTerminate:=true;
HTTP:=TIdHTTP.Create(nil);
HTTP.ReadTimeout := 2000;
Resume;
end;
destructor Thread.Destroy;
begin
try
If HTTP.Connected then
begin
HTTP.Disconnect(false);
HTTP.IOHandler.InputBuffer.Clear();
HTTP.IOHandler.Close;
Terminate;
end;
finally
WaitFor;
FreeAndNil(HTTP);
end;
inherited;
end;
procedure Thread.Execute;
begin
while (LocalWork=True) do
begin
if LocalWork=true then
begin
HTTP.Get(target);
if HTTP.ResponseCode=200 then
begin
result:=1;
end
else
begin
result:=2;
end;
Synchronize(Local);
end
else
begin
EndThread(0);
end;
end;
EndThread(0);
end;
procedure Thread.Local;
begin
if result=1 then Form1.sm1.Lines.Add('Good ');
if result=2 then Form1.sm1.Lines.Add('Bad ');
end;
procedure TForm1.StartBtnClick(Sender: TObject);
var
i:integer;
begin
target := sdt1.Text;
LocalWork := True;
for I := 0 to ThreadCount.Value-1 do
begin
sm1.Lines.Add('Thread createrd '+inttostr(i));
Thread.Create(true); // создаем замароженный поток
end;
end;
procedure TForm1.StopBtnClick(Sender: TObject);
begin
LocalWork:=false;
end;
initialization
ReportMemoryLeaksOnShutdown := True;
end.

Inside the thread constructor, call inherited Create(false);. And skip the Resume call at the end. The thread will not start until the constructor has finished anyway.
In the thread Execute method, skip the EndThread calls, since the thread will handle this when the Execute method ends.
In the Destroy destructor, do not call Terminate and Waitfor. They do not belong there at all. The thread is told to FreeOnTerminate, and will do so gracefully.

Related

Reading thread's fields from synchronized event handler

Is it safe to read a thread object's fields from an event handler called by the Synchronize procedure?
For example:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;
type
TMyThread = class(TThread)
public
Max : Integer;
Position : Integer;
OnPositionChanged : TNotifyEvent;
procedure Execute(); override;
end;
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
procedure FormCreate(Sender: TObject);
private
procedure MyOnPositionChanged(Sender : TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
Th : TMyThread;
procedure TMyThread.Execute();
begin
while not Terminated do
begin
//doing stuffs
Sleep(500);
//position + 1
Inc(Position);
//event handler
if(Assigned(OnPositionChanged)) then
begin
Synchronize(
procedure()
begin
OnPositionChanged(Self);
end
);
end;
//check for reaching the max value
if(Position = Max)
then Terminate;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//preparing thread
Th := TMyThread.Create(True);
Th.FreeOnTerminate := True;
Th.Max := ProgressBar1.Max;
Th.Position := ProgressBar1.Position;
Th.OnPositionChanged := MyOnPositionChanged;
//starting thread
Th.Start;
end;
procedure TForm1.MyOnPositionChanged(Sender : TObject);
begin
//updating progressbar
ProgressBar1.Position := (Sender as TMyThread).Position;
end;
end.
I'm wondering if there could be some thread-safety problem in reading the thread's fields from the main thread while the other thread is running
Yes, this is generally safe. The thread's Execute() method is blocked while Synchronize() is running, so the thread won't be updating the fields while the main thread is using them.
Where this can break down is if you happen to have another thread updating the same fields without Synchronize()'ing access to them.

Delphi - random access violation in DLL Thread

I do something wrong, but what exactly?
I have simple DLL with thread. From App I put message in DLL queue, and DLL thread put message to callback.
When I use push in the application not in main thread everything fine.
Also everything is fine if I don't use DLL at all, and use thread with queue just in the application (or use DLL without TThread).
But when I push from main thread - I get random AV (in random time, in a random place)
uTestThread.pas
unit uTestThread;
interface
uses
Winapi.Windows, System.Classes, System.SyncObjs,
System.Generics.Collections;
type
TTestCallback = procedure(Data: Pointer);
TTestThread = class(TThread)
private
FLock: TRTLCriticalSection;
FQueue: TQueue<Pointer>;
FCallback: TTestCallback;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
procedure Push(Data: Pointer);
property Callback: TTestCallback read FCallback write FCallback;
end;
implementation
{ TTestThread }
constructor TTestThread.Create;
begin
InitializeCriticalSection(FLock);
FQueue:=TQueue<Pointer>.Create;
Inherited Create(True);
end;
destructor TTestThread.Destroy;
begin
FQueue.Free;
DeleteCriticalSection(FLock);
inherited;
end;
procedure TTestThread.Execute;
var
O: Pointer;
begin
while not Terminated do
begin
EnterCriticalSection(FLock);
try
if FQueue.Count > 0 then
begin
if Assigned(FCallback) then
begin
O:=FQueue.Dequeue;
FCallback(O);
end;
end;
except //on E: Exception do
//OutputDebugString(PChar('==='+E.Message+'==='));
end;
LeaveCriticalSection(FLock);
end;
end;
procedure TTestThread.Push(Data: Pointer);
begin
EnterCriticalSection(FLock);
try
FQueue.Enqueue(Data);
finally
LeaveCriticalSection(FLock);
end;
end;
end.
DLL
library lib;
uses
uTestThread in 'src\test\uTestThread.pas';
{$R *.res}
var
TT: TTestThread;
procedure Push(Data: TTestDataOut);
begin
TT.Push(Data);
end;
procedure TestThreadCreate(Callback: TTestCallback);
begin
TT:=TTestThread.Create;
TT.Callback:=Callback;
TT.Start;
end;
exports
TestThreadCreate,
Push;
begin
end.
App form
unit frmMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, uTestThread;
type
TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure AddX;
public
{ Public declarations }
end;
var
Form2: TForm2;
procedure TestThreadCreate(Data: TTestCallback); external 'lib.dll';
procedure Push(Data: Pointer); external 'lib.dll';
implementation
{$R *.dfm}
procedure TestCallback(Data: TTestDataOut);
begin
// OutputDebugString(PChar(TStringStream(Data).DataString));
TObject(Data).Free;
end;
{ TForm2 }
procedure TForm2.AddX;
var
I: Integer;
S: string;
O: Pointer;
begin
for I:=0 to 9999 do
begin
// S:='F'+IntToStr(I)+' zzzzzzzzzzzzzzzzzzzzzzzzzWWzzzzzzzzzzzsssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssszzzx';
// O:=TStringStream.Create(S);
O:=TObject.Create;
Push(O);
end;
OutputDebugString(PChar('End'));
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
TestThreadCreate(TestCallback);
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
// Everything fine !!!
//
// TThread.CreateAnonymousThread(procedure
// begin
// AddX;
// end).Start;
// Get random AV !!!
AddX;
end;
end.
AV example
---------------------------
GExperts Debugger Exception Notification
---------------------------
Project lib.exe raised exception class EAccessViolation with message 'Access violation at address 004059B1. Read of address FFFFFFFC'.
---------------------------
ThreadId=2644
ProcessId=130
ThreadName=""
ExceptionMessage="Access violation at address 004059B1. Read of address FFFFFFFC"
ExceptionName="EAccessViolation"
ExceptionDisplayName="$C0000005"
ExceptionAddress=004059B1
FileName="GETMEM.INC"
LineNumber=1973
---------------------------
To demonstrate the problem, I use "while True do"
I know that FCallback should also be protected, but for demonstration I skip this
I dont create a thread in DllMain because:
https://learn.microsoft.com/en-us/windows/win32/dlls/dynamic-link-library-best-practices
As lock I tried to use TRTLCriticalSection / TCriticalSection / TMonitor / TMutex
As message I tried to use Pointer / WideString / PChar (and copy string)
As callback I tried to use Interface and Pointer to Procedure
As queue I tried TQueue<> / TList<> / TList / Array
I suspect something wrong with callback, because if I use queued item in DLL memory everything also fine

multithreading in Delphi

I have a number crunching application with a TExecution class that is included in a separate unit Execution.pas and carries out all the calculations. The class instances are created from the main form of the program. Very often the code in Execution.pas needs to run 10-15 times in a row and I want to create several TExecution instances in different threads and run them in parallel. A simplified version of the code is as follows:
Main Form with one Button1 in it:
unit MainForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Threading, Execution;
type
TMainForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;
var
MainForm1: TMainForm1;
implementation
{$R *.dfm}
procedure TMainForm1.Button1Click(Sender: TObject);
var
ExecutionThread: array of TThread;
NoThreads: integer;
Execution: array of TExecution;
thread_ID: integer;
begin
NoThreads := 5;
SetLength(Execution,NoThreads);
SetLength(ExecutionThread,NoThreads);
//----------------------------------------------------------------------------------
for thread_ID := 0 to Pred(NoThreads) do
begin
ExecutionThread[thread_ID] := TThread.CreateAnonymousThread(
procedure
begin
try
Execution[thread_ID] := TExecution.Create;
Execution[thread_ID].CalculateSum;
finally
if Assigned(Execution[thread_ID]) then
begin
Execution[thread_ID] := nil;
Execution[thread_ID].Free;
end;
end;
end);
ExecutionThread[thread_ID].FreeOnTerminate := true;
ExecutionThread[thread_ID].Start;
end;
end;
end.
Execution.pas unit:
unit Execution;
interface
uses
System.SysUtils, Vcl.Dialogs, System.Classes, WinApi.Windows;
type
TExecution = Class
const
NoOfTimes = 1000000;
var
Sum: integer;
private
procedure IncrementSum(var Sum: integer);
published
procedure CalculateSum;
End;
implementation
procedure TExecution.CalculateSum;
var
i: integer;
begin
Sum := 0;
for i := 0 to Pred(NoofTimes) do
begin
IncrementSum(Sum);
end;
end;
procedure TExecution.IncrementSum(var Sum: integer);
begin
Inc(Sum);
end;
end.
Whenever I run the code above by clicking Button1 the TExecution instances run, but when I close the program, I get an Access Violation in GetMem.inc in function SysFreeMem. Obviously, the code messes up the memory, I guess it is because of the parallel memory allocation, but I was unable to find the cause and fix a solution to it.
I note that with one thread (NoThreads := 1), or with a serial execution of the code (either with a single new thread and 5 TExecution instances, or when the instances of TExecution are created directly from MainForm), I do not get similar memory problems. What is the problem with my code?
Many thanks in advance!
The problem comes from ExecutionThread and Execution which are local variables. When all threads are started, the procedure Button1Click exits, the two variables are freed, long before threads are terminated.
Move the two variables ExecutionThread and Execution to the TMainForm1 field and your problem will be gone. Of course: if you close the program before the threads are terminated, you'll be again in trouble.
Also, invert the two lines:
Execution[thread_ID] := nil;
Execution[thread_ID].Free;
You must free before niling.
BTW: You should get a compiler warning about published in TExecution.
EDIT:
Following the comment on this answer, here is the code for the same process but using an explicit worker thread and a generic TList to maintain the list of running thread.
Source for the main form:
unit ThreadExecutionDemoMain;
interface
uses
Winapi.Windows, Winapi.Messages,
System.SysUtils, System.Variants, System.Classes,
System.Generics.Collections,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
ThreadExecutionDemoExecution,
ThreadExecutionDemoWorkerThread;
type
TMainForm = class(TForm)
StartButton: TButton;
DisplayMemo: TMemo;
procedure StartButtonClick(Sender: TObject);
private
ThreadList : TList<TWorkerThread>;
procedure WrokerThreadTerminate(Sender : TObject);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
constructor TMainForm.Create(AOwner: TComponent);
begin
ThreadList := TList<TWorkerThread>.Create;
inherited Create(AOwner);
end;
destructor TMainForm.Destroy;
begin
FreeAndNil(ThreadList);
inherited Destroy;;
end;
procedure TMainForm.StartButtonClick(Sender: TObject);
var
NoThreads : Integer;
ID : Integer;
WorkerThread : TWorkerThread;
begin
NoThreads := 5;
for ID := 0 to Pred(NoThreads) do begin
WorkerThread := TWorkerThread.Create(TRUE);
WorkerThread.ID := ID;
WorkerThread.OnTerminate := WrokerThreadTerminate;
WorkerThread.FreeOnTerminate := TRUE;
ThreadList.Add(WorkerThread);
DisplayMemo.Lines.Add(Format('Starting thread %d', [WorkerThread.ID]));
WorkerThread.Start;
end;
DisplayMemo.Lines.Add(Format('There are %d running threads', [ThreadList.Count]));
end;
procedure TMainForm.WrokerThreadTerminate(Sender: TObject);
var
WorkerThread : TWorkerThread;
begin
WorkerThread := TWorkerThread(Sender);
ThreadList.Remove(WorkerThread);
// This event handler is executed in the context of the main thread
// we can access the user interface directly
DisplayMemo.Lines.Add(Format('Thread %d done. Sum=%d',
[WorkerThread.ID, WorkerThread.Sum]));
if ThreadList.Count = 0 then
DisplayMemo.Lines.Add('No more running threads');
end;
end.
Source for the execution unit:
unit ThreadExecutionDemoExecution;
interface
type
TExecution = class
const
NoOfTimes = 1000000;
private
FSum: Integer;
procedure IncrementSum(var ASum: Integer);
public
procedure CalculateSum;
property Sum: Integer read FSum
write FSum;
end;
implementation
{ TExecution }
procedure TExecution.CalculateSum;
var
I: Integer;
begin
FSum := 0;
for I := 0 to Pred(NoOfTimes) do
IncrementSum(FSum);
end;
procedure TExecution.IncrementSum(var ASum: Integer);
begin
Inc(ASum);
end;
end.
Source for the worker thread:
unit ThreadExecutionDemoWorkerThread;
interface
uses
System.SysUtils, System.Classes,
ThreadExecutionDemoExecution;
type
TWorkerThread = class(TThread)
private
FExecution : TExecution;
FID : Integer;
FSum : Integer;
protected
procedure Execute; override;
public
property ID : Integer read FID
write FID;
property Sum : Integer read FSum
write FSum;
end;
implementation
{ TWorkerThread }
procedure TWorkerThread.Execute;
begin
FExecution := TExecution.Create;
try
FExecution.CalculateSum;
FSum := FExecution.Sum;
finally
FreeAndNil(FExecution);
end;
end;
end.

How to show a "Please wait " modal form from a TThread and free it when the job is done?

I've been working just for a while trying to make a modal form to inform the user to wait until the job is ends.
This is a simple example of what I'm trying to do:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TLoader = class(TThread)
private
FStrings: TStrings;
procedure ShowWait;
procedure EndsWait;
public
Constructor Create(AStrings: TStrings);
Destructor Destroy; override;
procedure Execute; override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
Var
List: TStrings;
begin
List := TStringList.Create;
try
// Load Some Data here
TLoader.Create(List);
finally
List.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
{ TLoader }
constructor TLoader.Create(AStrings: TStrings);
begin
inherited Create;
FreeOnTerminate:= True;
FStrings:= TStringList.Create;
FStrings.AddStrings(AStrings);
end;
destructor TLoader.Destroy;
begin
FStrings.Free;
inherited;
end;
procedure TLoader.EndsWait;
begin
TForm(Application.FindComponent('FWait')).Free;
end;
procedure TLoader.Execute;
begin
inherited;
Synchronize(ShowWait);
// Do Some Job while not terminated
Sleep(1000);
// Free Wait Form
// This part is not working
Synchronize(EndsWait);
end;
procedure TLoader.ShowWait;
begin
With TForm.Create(Application) do
begin
// Some code
Name:= 'FWait';
ShowModal;
end;
end;
end.
Everything is working as I expected, except Synchronize(EndsWait); which did not close and free the modal form.
How can I display a modal form while a TThread is running and free it when the TThread terminated?
UPDATE:
I've try to do as Remy suggest as the following:
type
TForm2 = class(TForm)
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TLoader = class(TThread)
protected
procedure DoTerminate; override;
procedure DoCloseModal;
public
constructor Create;
procedure Execute; override;
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
{ TLoader }
constructor TLoader.Create;
begin
inherited Create;
FreeOnTerminate:= True;
end;
procedure TLoader.DoCloseModal;
begin
Form2.ModalResult:= mrOk;
end;
procedure TLoader.DoTerminate;
begin
inherited DoTerminate;
Synchronize(DoCloseModal);
end;
procedure TLoader.Execute;
begin
inherited;
Sleep(200);
end;
procedure TForm2.FormShow(Sender: TObject);
begin
TLoader.Create;
end;
end.
The main form button click event handler:
procedure TForm1.Button1Click(Sender: TObject);
begin
with TForm2.Create(nil) do
try
ShowModal;
finally
Free;
end;
end;
You have two choices:
Do not use a modal form to begin with. TThread.Synchronize() blocks your thread until the synced method exits, but TForm.ShowModal() blocks that method until the Form is closed. Use TThread.Synchronize() (or better, TThread.Queue()) to Create()+Show() (not ShowModal()) the Wait Form, then return to the thread and let it do its work as needed, then Synchronize()/Queue() again (or, use the thread's OnTerminate event) to Close()+Free() the Wait Form when done.
alternatively, if you want to use a modal Wait Form, then do not let the thread manage the Wait Form at all. Have your button OnClick handler Create()+ShowModal() (not Show()) the Wait Form, and Free() it when ShowModal() exits. Have the Wait Form internally create and terminate the thread when the Wait Form is shown and closed, respectively. If the thread ends before the Wait Form is closed, the thread's OnTerminate handler can Close() the Form (which simply sets the Form's ModalResult) so that ShowModal() will exit in the OnClick handler.
After a while, I made a uWaitForm.pas unit:
unit uWaitForm;
interface
uses
System.Classes, Vcl.Controls, Vcl.Forms;
type
TWaitForm = class(TForm)
private
FThread: TThread;
protected
procedure Activate; override;
procedure DoClose(var Action: TCloseAction); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TWaitThread = class(TThread)
private
FForm: TWaitForm;
FModalResult: TModalResult;
protected
procedure Execute; override;
procedure DoSetModalResult;
public
constructor Create(AForm: TWaitForm);
destructor Destroy; override;
end;
implementation
{ TWaitForm }
procedure TWaitForm.Activate;
begin
inherited;
FThread:= TWaitThread.Create(Self);
end;
constructor TWaitForm.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Name:= 'WaitForm';
BorderStyle:= bsDialog;
Caption:= 'Please wait...';
Width:= 200;
Height:= 150;
Position:= poDesktopCenter;
end;
destructor TWaitForm.Destroy;
begin
if Assigned(FThread) then
FThread.Terminate;
inherited;
end;
procedure TWaitForm.DoClose(var Action: TCloseAction);
begin
inherited;
if Assigned(FThread) then
begin
TWaitThread(FThread).FModalResult:= mrCancel;
FThread.Terminate;
end;
end;
{ TWaitThread }
constructor TWaitThread.Create(AForm: TWaitForm);
begin
inherited Create;
FreeOnTerminate:= True;
FForm:= AForm;
FModalResult:= mrOk;
end;
destructor TWaitThread.Destroy;
begin
if Assigned(FForm) then
Synchronize(nil, DoSetModalResult);
inherited;
end;
procedure TWaitThread.DoSetModalResult;
begin
FForm.ModalResult:= FModalResult;
end;
procedure TWaitThread.Execute;
begin
inherited;
// Do the work while not terminated
// You can check for Terminated here and set FModalResult accordingly to receive it from ShowModal
// By default it's mrOk (Job is done, the thread doesn't cancled)
Sleep(200);
end;
end.
Then use it
with TWaitForm.Create(nil) do
try
//Get ModalResult here and do something accordingly
// mrCancel means the dialog form closed and the the Thread job aborted
// mrOk The job is done and the form closed
ShowModal;
finally
Free;
end;

How can I terminate thread directly outside of thread in delphi?

I want to terminate thread by clicking the button. If the thread normally works without user interruption it is OK but sometimes user needs to abort thread and that's the question that how user abort the thread.
Here is my code that I tested:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, mmsystem, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
procedure Image1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
end;
type
hangth = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure play;
end;
var
Form1: TForm1;
played: boolean;
szalhang: hangth;
implementation
{$R *.dfm}
procedure hangth.play;
begin
played := true;
szalhang.Terminate;
end;
procedure hangth.Execute;
begin
played := false;
SndPlaySound(pchar('hang.wav'), SND_SYNC);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
played := true;
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
if played = true then begin
szalhang := hangth.Create(true);
szalhang.Resume;
end else begin
szalhang.Terminate();
// here i want to terminate thread, but it doesn't want to be killed.
end;
end;
end.
When you call TThread.Terminate(), it sets the TThread.Terminated property to true and does nothing else. It is the responsibility of your TThread.Execute() code to look at the TThread.Terminated property periodically and exit gracefully when it is True. However, in this situation, that is not possible because SndPlaySound() is blocking the thread, and there is no way to interrupt SndPlaySound() when it is running in SND_SYNC mode. Your only option would be to use the Win32 API TerminateThread() function to perform a brute-force termination of the thread.
Since you obviously need more control over the playback of the audio, and detection of when the audio is finished playing, then SndPlaySound() is not the best solution for your needs. You have a TForm, you might consider using Delphi's TMediaPlayer component, for example:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.MPlayer;
type
MPlayerState = (mpsClosed, mpsOpened, mpsPlaying);
TForm1 = class(TForm)
Image1: TImage;
MediaPlayer1: TMediaPlayer;
procedure MediaPlayer1Notify(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Image1Click(Sender: TObject);
private
{ Private declarations }
State: MPlayerState;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm56.FormCreate(Sender: TObject);
begin
State := mpsClosed;
MediaPlayer1.FileName := 'C:\full path to\hang.wav';
end;
procedure TForm56.MediaPlayer1Notify(Sender: TObject);
begin
case MediaPlayer1.Mode of
mpStopped, mpPlaying:
State := mpsOpened;
end;
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
if State = mpsClosed then
begin
MediaPlayer1.Notify := False;
MediaPlayer1.Wait := True;
MediaPlayer1.Open;
State := mpsOpened;
end;
if State = mpsOpened then
begin
MediaPlayer1.Notify := True;
MediaPlayer1.Wait := False;
MediaPlayer1.Play;
if MediaPlayer1.Error = 0 then
State := mpsPlaying
end else
begin
MediaPlayer1.Notify := False;
MediaPlayer1.Wait := True;
MediaPlayer1.Stop;
State := mpsOpened;
MediaPlayer1.Notify := False;
MediaPlayer1.Wait := True;
MediaPlayer1.Close;
State := mpsClosed;
end;
end;
end.

Resources