When ButtonConnectClick is activated it gives the Segmentation (11) exception.
I think it's caused by pocForm1.AddLine('new line by thread'); in the thread, but I'm not sure how to solve it.
The idea is to add lines to the memo field while the thread is active.
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, FMX.Layouts,
FMX.Memo, FMX.StdCtrls, IdGlobal, IdIntercept;
type
TpocForm1 = class(TForm)
ButtonConnect: TButton;
ButtonDisconnect: TButton;
Memo1: TMemo;
procedure ButtonConnectClick(Sender: TObject);
procedure ButtonDisconnectClick(Sender: TObject);
procedure AddLine(text : String);
private
public
{ Public declarations }
end;
TpocTCPClientThread = class(TThread)
//TCPClient: TIdTCPClient;
protected
procedure Execute; override;
end;
var
pocForm1: TpocForm1;
implementation
{$R *.fmx}
var
thread: TpocTCPClientThread;
procedure TpocForm1.ButtonConnectClick(Sender: TObject);
begin
Memo1.Lines.Add('Client connected with server');
thread:= TpocTCPClientThread.Create(False);
end;
procedure TpocForm1.ButtonDisconnectClick(Sender: TObject);
begin
thread.Terminate;
thread.WaitFor;
FreeAndNil(thread);
Memo1.Lines.Add('Client disconnected from server');
end;
procedure TpocForm1.AddLine(text : String);
begin
Memo1.Lines.Add(text);
end;
procedure TpocTCPClientThread.Execute();
begin
while not Terminated do
begin
pocForm1.AddLine('new line by thread');
end;
end;
end.
You cannot execute GUI code from outside the main thread. You need to ensure that all your GUI code executes on the main thread. For instance by calling TThread.Queue or TThread.Synchronize.
Related
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.
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
I have problem when run a thread in subform.
main form
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses Unit2;
procedure TForm1.Button1Click(Sender: TObject);
begin
TForm2.create(form1).ShowModal;
end;
SUBform
type
TMthread=class(Tthread)
protected
procedure execute; override;
end;
type
TForm2 = class(TForm)
Label1: TLabel;
procedure FormShow(Sender: TObject);
private
public
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
uses Unit1;
procedure TMthread.Execute;
begin
synchronize( procedure
begin
sleep(200);
freeonterminate:=true;
sleep(200);
form2.label1.Caption:='beep';
form1.button1.Caption:='beep';
end);
end;
procedure TForm2.FormShow(Sender: TObject);
var Loadcombo2: TMthread;
begin
Loadcombo2:=TMthread.Create(False);
end;
Program
program Project1;
uses
Vcl.Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
I got error in Execute Procedure when trying to access Form2.Label1.caption.
my test:
When I add the subform(Form2) in the Initialize section(last code) the the application runs without error, but doesn't change Label1.caption on the Form2.(Button1.caption on the main form is changed)
When I put exactly the same thread in main form it works without issues.
The variable Form2 is never assigned. Because it is a global variable, its value is nil. Thus you encounter an error when you attempt to reference members of Form2.
You create an instance of Form2 like this:
TForm2.Create(Form1).ShowModal;
I suspect that instead you mean to write something like this:
Form2 := TForm2.Create(Form1);
Try
Form2.ShowModal;
Finally
Form2.Free;
End;
I have an application that the user can run either interactively or from command line. In the second mode, the program must exit upon completion.
Here is the basic minimal code. It seems that application.terminated is never set;
How do I get this program to close, w/o0 user interaction.
unit Unit4;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls ;
type
TForm4 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
procedure DoSomeStuff;
{ Private declarations }
public
{ Public declarations }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
procedure TForm4.Button1Click(Sender: TObject);
var
anonThread : TThread;
begin
anonThread := TThread.CreateAnonymousThread(procedure
begin
while not application.terminated do
begin
doSomeStuff;
end;
end);
anonThread.Start;
end;
procedure TForm4.DoSomeStuff;
var
i : integer;
begin
for i := 0 to 10 do
begin
beep;
sleep(100);
end;
application.Terminate;
end;
end.
The Application.Terminated property doesn't work without the message loop in Application.Run() (or at least a manual loop that calls Application.ProcessMessages()) in the main UI thread. This is because Application.Terminate() simply posts a WM_QUIT message to the calling thread's message queue. Application.Terminated is not set until that message is processed. A console app typically does not call Application.Run(), so Application.Terminated does not work on a console app.
You should redesign your code to remove the dependency on Application and your TForm in console mode, eg:
program MyApp;
uses
MyWorkUnit, Unit4;
begin
if IsRunInCommandLineMode then
begin
DoSomeStuff;
end else
begin
Application.Initialize;
Application.CreateForm(TForm4, Form4)
Application.Run;
end;
end.
unit MyWorkUnit;
interface
procedure DoSomeStuff;
implementation
procedure DoSomeStuff;
var
i : Integer;
begin
for i := 0 to 10 do
begin
Beep;
Sleep(100);
end;
end;
end.
unit Unit4;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm4 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
uses
MyWorkUnit;
procedure TForm4.Button1Click(Sender: TObject);
begin
TThread.CreateAnonymousThread(
procedure
begin
while not Application.Terminated do
DoSomeStuff;
end
).Start;
end;
end.
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.