Output of multi-threaded program does not display correctlty - multithreading

Question

I have written a program that has been troubled by the network. It was used in the multithreading. The problem is thread output. The program is mixed. And the output does not display correctly.
I have written two sample programs, neither of which work correctly.
Program 1
unit Unit1;
interface
uses
Windows, Classes, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdRawBase,IdRawClient, IdIcmpClient, Messages, SysUtils, Variants, Graphics, Controls, Forms,
Dialogs,StdCtrls,ExtCtrls;
type
TPSThread=class(TThread)
protected
procedure execute; override;
end;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
Procedure WndProc(var Message: TMessage); Override;
{ Public declarations }
end;
var
Form1: TForm1;
PortG:Integer;
HostG:string;
FormG:TForm;
WM_Msg_PS:DWORD;
implementation
{$R *.dfm}
procedure TPSThread.execute;
var
IcmpClient:TIdIcmpClient;
TCPClient:TIdTCPClient;
HostT:string;
PortT:Integer;
ActiveServer:Boolean;
begin
inherited;
HostT:=HostG;
PortT:=PortG;
IcmpClient:= TIdIcmpClient.Create();
try
with IcmpClient do
begin
ReceiveTimeout := 5000;
Protocol := 1;
ProtocolIPv6 := 0;
PacketSize := 1024;
Host:=HostT;
end;
IcmpClient.Ping(HostT,Random(1024));
if IcmpClient.ReplyStatus.BytesReceived=0 then
begin
SendMessage(FormG.Handle, WM_Msg_PS, Integer(HostT+'*'+IntToStr(1)+'#'), 0);
ActiveServer:=False;
end
else
ActiveServer:=True;
finally
IcmpClient.Free;
end;
if ActiveServer then
begin
TCPClient:=TIdTCPClient.Create(nil);
try
with TCPClient do
begin
Host:=HostT;
Port:=PortT;
try
Connect;
try
IOHandler.WriteLn('salam');
SendMessage(FormG.Handle, WM_Msg_PS, Integer(HostT+'*'+IntToStr(2)+'#'), 0);
finally
Disconnect;
end;
except
SendMessage(FormG.Handle, WM_Msg_PS, Integer(HostT+'*'+IntToStr(3)+'#'), 0);
end;
end;
finally
TCPClient.Free;
end;
end;
end;
procedure PS_System(FormNameForMessage:TForm;HostP:string;PortP:Integer);
var
PSThread:TPSThread;
begin
HostG:=HostP;
PortG:=PortP;
FormG:=FormNameForMessage;
PSThread:=TPSThread.Create(false);
PSThread.FreeOnTerminate:=true;
PSThread.Resume;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
PS_System(form1,Edit1.Text,4321);
PS_System(form1,Edit2.Text,4321);
PS_System(form1,Edit3.Text,4321);
PS_System(form1,Edit4.Text,4321);
PS_System(form1,Edit5.Text,4321);
end;
procedure TForm1.WndProc(var Message: TMessage);
var Id:byte;
Ip:string;
begin
if Message.Msg= WM_Msg_PS then
begin
Ip:=copy(String(Message.WParam),1,pos('*',String(Message.WParam))-1);
id:=strtoint(copy(String(Message.WParam),pos('*',String(Message.WParam))+1,(pos('#',String(Message.WParam))-pos('*',String(Message.WParam))-1)));
case id of
1:
begin
Memo1.Lines.Add(' Server '+ip+' Is inactive ');
//ShowMessage(' Server '+ip+' Is inactive ');
end;
2:
begin
Memo1.Lines.Add(' Message was sent successfully to server '+ip);
//ShowMessage(' Message was sent successfully to server '+ip);
end;
3:
begin
Memo1.Lines.Add(' Send message to the server fails '+ip);
//ShowMessage(' Send message to the server fails '+ip);
end;
end;
end;
inherited;
end;
end.
Program 2
unit Unit1;
interface
uses
Windows, Classes, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdRawBase,IdRawClient, IdIcmpClient, Messages, SysUtils, Variants, Graphics, Controls, Forms,
Dialogs,StdCtrls,ExtCtrls;
type
TPSThread=class(TThread)
protected
procedure execute; override;
end;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
PortG:Integer;
HostG:string;
WM_Msg_PS:DWORD;
implementation
{$R *.dfm}
procedure IsInactiveServer(M:string);
begin
Form1.Memo1.Lines.Add(' Server '+M+' Is inactive ');
//ShowMessage(' Server '+M+' Is inactive ');
end;
procedure SentSuccessfullyToServer(M:string);
begin
Form1.Memo1.Lines.Add(' Message was sent successfully to server '+M);
//ShowMessage(' Message was sent successfully to server '+M);
end;
procedure SendMessageFails(M:string);
begin
Form1.Memo1.Lines.Add(' Send message to the server fails '+M);
//ShowMessage(' Send message to the server fails '+M);
end;
procedure TPSThread.execute;
var
IcmpClient:TIdIcmpClient;
TCPClient:TIdTCPClient;
HostT:string;
PortT:Integer;
ActiveServer:Boolean;
begin
inherited;
HostT:=HostG;
PortT:=PortG;
IcmpClient:= TIdIcmpClient.Create();
try
with IcmpClient do
begin
ReceiveTimeout := 5000;
Protocol := 1;
ProtocolIPv6 := 0;
PacketSize := 1024;
Host:=HostT;
end;
IcmpClient.Ping(HostT,Random(1024));
if IcmpClient.ReplyStatus.BytesReceived=0 then
begin
IsInactiveServer(HostT);
ActiveServer:=False;
end
else
ActiveServer:=True;
finally
IcmpClient.Free;
end;
if ActiveServer then
begin
TCPClient:=TIdTCPClient.Create(nil);
try
with TCPClient do
begin
Host:=HostT;
Port:=PortT;
try
Connect;
try
IOHandler.WriteLn('salam');
SentSuccessfullyToServer(HostT);
finally
Disconnect;
end;
except
SendMessageFails(HostT);
end;
end;
finally
TCPClient.Free;
end;
end;
end;
procedure PS_System(HostP:string;PortP:Integer);
var
PSThread:TPSThread;
begin
HostG:=HostP;
PortG:=PortP;
PSThread:=TPSThread.Create(false);
PSThread.FreeOnTerminate:=true;
PSThread.Resume;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
PS_System(Edit1.Text,4321);
PS_System(Edit2.Text,4321);
PS_System(Edit3.Text,4321);
PS_System(Edit4.Text,4321);
PS_System(Edit5.Text,4321);
end;
end.
Thank you
But my problem is not the ping
The my problem is the send message.
They also interfere with the thread send message.
If the parts do I remove my ping. Again there is the added problem.

Answer 1

Does this compile? TThread.Execute() is abstract - you cannot call 'inherited' in your descendant 'TPSThread.execute'. Do you not get an error from the compiler?
Creating your TPSThread with 'CreateSuspended' as false means that the thread may run 'immediately'. Setting fields after the Create call may not be effective.
Continually creating and destroying threads is wasteful, inefficient and prone to errors. Try hard not to do it.
If you want your four 'PS_System' calls to perform the network ping operations in a different thread, (so as not to block the main thread), but in sequential order, you should queue the output requests off to one thread that is waiting on a producer-consumer queue to perform them.
Performing ICMP operations in parallel on seperate threads can be problematic since ICMP has no socket layer. PING replies may not be returned to the same thread that issued the request. There is a workaround - the ping payload may contain the requesting thread ID and a 'routing' layer in the ICMP component can work out which waiting thread to make ready. I don't know if the Indy ICMP has implemented this.
The helper procedures that are called from the thread add text to the GUI thread directly. You cannot do that - you must signal correctly.
Multi-threaded PING example, (TCP connection obviously fails - I have no server):
unit foPinger;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, SyncObjs,Contnrs, IdBaseComponent,
IdComponent, IdRawBase, IdRawClient, IdIcmpClient, IdTCPConnection,
IdTCPClient;
type
EthreadRequest=(EtcDoPing,EtcReport,EtcError,EtcSuicide);
TpingRequest=class(TObject) // a thread comms object
command:EthreadRequest;
hostName:string;
port:string;
reportText:string;
errorMess:string;
end;
pObject=^Tobject;
TsemaphoreMailbox=class(TobjectQueue) // Producer-consumer queue
private
countSema:Thandle;
protected
access:TcriticalSection;
public
property semaHandle:Thandle read countSema;
constructor create; virtual;
procedure push(aObject:Tobject); virtual;
function pop(pResObject:pObject;timeout:DWORD):boolean; virtual;
function peek(pResObject:pObject):boolean; virtual;
destructor destroy; override;
end;
TPSThread=class(TThread) // The thread to try the network comms
private
FinQueue:TsemaphoreMailbox;
IcmpClient:TIdIcmpClient;
TCPClient:TIdTCPClient;
ActiveServer:Boolean;
FmyForm:TForm;
protected
procedure execute; override;
public
constructor create(myForm:TForm;inputQueue:TsemaphoreMailbox);
procedure postToMain(mess:TpingRequest);
procedure postReport(text:string);
end;
TpingerForm = class(TForm) // main form
Panel1: TPanel;
sbPing1: TSpeedButton;
ebHostName: TEdit;
Memo1: TMemo;
ebPort: TEdit;
Label1: TLabel;
Label2: TLabel;
ebThreadCount: TEdit;
Label3: TLabel;
procedure sbPing1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ebThreadCountChange(Sender: TObject);
private
threadCount:integer;
queueToThreads:TsemaphoreMailbox;
protected
procedure WMAPP(var message:Tmessage); message WM_APP;
public
{ Public declarations }
end;
var
pingerForm: TpingerForm;
implementation
{$R *.dfm}
{ TsemaphoreMailbox }
constructor TsemaphoreMailbox.create;
begin
inherited Create;
access:=TcriticalSection.create;
countSema:=createSemaphore(nil,0,maxInt,nil);
end;
destructor TsemaphoreMailbox.destroy;
begin
access.free;
closeHandle(countSema);
inherited;
end;
function TsemaphoreMailbox.pop(pResObject: pObject;
timeout: DWORD): boolean;
// dequeues an object, if one is available on the queue. If the queue is empty,
// the caller is blocked until either an object is pushed on or the timeout
// period expires
begin // wait for a unit from the semaphore
result:=(WAIT_OBJECT_0=waitForSingleObject(countSema,timeout));
if result then // if a unit was supplied before the timeout,
begin
access.acquire;
try
pResObject^:=inherited pop; // get an object from the queue
finally
access.release;
end;
end;
end;
procedure TsemaphoreMailbox.push(aObject: Tobject);
// pushes an object onto the queue. If threads are waiting in a 'pop' call,
// one of them is made ready.
begin
access.acquire;
try
inherited push(aObject); // shove the object onto the queue
finally
access.release;
end;
releaseSemaphore(countSema,1,nil); // release one unit to semaphore
end;
function TsemaphoreMailbox.peek(pResObject: pObject): boolean;
begin
access.acquire;
try
result:=(Count>0);
if result then pResObject^:=inherited pop; // get an object from the queue
finally
access.release;
end;
end;
{ TPSThread }
constructor TPSThread.create(myForm:TForm;inputQueue:TsemaphoreMailbox);
begin
inherited create(true);
FmyForm:=myForm;
FinQueue:=inputQueue;
FreeOnTerminate:=true;
Resume;
end;
procedure TPSThread.postToMain(mess:TpingRequest);
begin
PostMessage(FmyForm.Handle,WM_APP,integer(FmyForm),integer(mess));
end;
procedure TPSThread.postReport(text:string);
var reportMess:TpingRequest;
begin
reportMess:=TpingRequest.Create;
reportMess.command:=EtcReport;
reportMess.reportText:=text;
postToMain(reportMess);
end;
procedure TPSThread.execute;
var inMess:TpingRequest;
ActiveServer:Boolean;
procedure tryConnect;
begin
with IcmpClient do
begin
ReceiveTimeout := 5000;
Protocol := 1;
ProtocolIPv6 := 0;
PacketSize := 1024;
Host:=inMess.hostName;
end;
IcmpClient.Ping(inMess.hostName,Random(1024));
if IcmpClient.ReplyStatus.BytesReceived=0 then
begin
inMess.errorMess:=('PING failed');
ActiveServer:=False;
end
else
ActiveServer:=True;
if ActiveServer then
begin
with TCPClient do
begin
Host:=inMess.hostName;
Port:=strToInt(inMess.port);
try
Connect;
try
IOHandler.WriteLn('salam');
inMess.reportText:='Message was sent successfully to server';
finally
Disconnect;
end;
except
on e:exception do
begin
inMess.errorMess:=('TCP connection failed : '+e.Message);
end;
end;
end;
end;
end;
begin
postReport('PING thread started');
IcmpClient:= TIdIcmpClient.Create(); // make Indy components
TCPClient:=TIdTCPClient.Create(nil);
try
while FinQueue.pop(#inMess,INFINITE) do // wait for message
begin
try
case inMess.command of // switch on command in message
EtcDoPing: tryConnect;
EtcSuicide: begin
inMess.command:=EtcReport;
inMess.reportText:='Thread exit';
exit;
end;
else
begin
inMess.command:=EtcError;;
inMess.errorMess:='Command not understood in PSThread';
end;
end;
finally
postToMain(inMess); // send message back with results
end;
end;
finally
IcmpClient.Free; // free off all the stuff made in ctor
TCPClient.Free;
end;
end;
{ TpingerForm }
procedure TpingerForm.ebThreadCountChange(Sender: TObject);
var newThreads:integer;
suicideMess:TpingRequest;
begin
try
newThreads:=strToInt(ebThreadCount.Text);
while threadCount<newThreads do
begin
TPSThread.create(self,queueToThreads);
inc(threadCount);
end;
while threadCount>newThreads do
begin
suicideMess:=TpingRequest.Create;
suicideMess.command:=EtcSuicide;
queueToThreads.push(suicideMess);
dec(threadCount);
end;
except;
end;
end;
procedure TpingerForm.FormCreate(Sender: TObject);
var editThreadCount:integer;
begin
queueToThreads:=TsemaphoreMailbox.create;
editThreadCount:=strToInt(ebThreadCount.Text);
while(threadCount<editThreadCount) do // make initial number of threads
begin
TPSThread.create(self,queueToThreads);
inc(threadCount);
end;
end;
procedure TpingerForm.sbPing1Click(Sender: TObject);
var outMess:TpingRequest;
begin
outMess:=TpingRequest.Create; // make a thread comms object
outMess.command:=EtcDoPing; // fill up
outMess.hostName:=ebHostName.Text;
outMess.port:=ebPort.Text;
queueToThreads.push(outMess);
end;
// Message-handler for messages from thread
procedure TpingerForm.WMAPP(var message: Tmessage);
var inMess:TpingRequest;
procedure messReport;
begin
memo1.Lines.Add(inMess.reportText);
end;
procedure messError;
begin
memo1.Lines.Add('>*Error*< '+inMess.errorMess);
end;
procedure messPing;
var reportOut:string;
begin
reportOut:='Host '+inMess.hostName+', port: '+inMess.port+', ';
if (inMess.errorMess='') then
reportOut:=reportOut+'comms OK'
else
begin
reportOut:=reportOut+'comms failed: '+inMess.ErrorMess;
end;
memo1.Lines.Add(reportOut);
memo1.Lines.Add('');
end;
begin
inMess:=TpingRequest(message.LParam);
try
case inMess.command of
EtcReport: messReport;
EtcError: messError;
EtcDoPing:messPing;
end;
finally
inMess.Free;
end;
end;
end.

Answer 2

When writing code with threads, you need to understand the the execution order is not guaranteed, as a matter of a fact ,when programming in multi-thread, you should know that code that is not locked(synchronized) could be executed and cause non safe calls and cause data to behave not as expected.
Please read more on threads and understand the case of critical section thread synchronization is a good place to start.
if you need execution order ,then do all the calculation before the printing, wait for all the threads to finish, and then do all the printing. The Downside of this order ,is not real time printing, however, you get clean output.