tIdHttp Inside thread and IdTCPServer in GUI - multithreading

Question

I have a TTimer on a TForm, where the timer is set to 5 seconds and creates 100 threads to fetch XML from a remote server.
Each time a thread is executed, I add the XML to a variable (FullXML_STR:String).
When all threads have finished, I am sending the FullXML_STR to all Clients connected to a TIdTCPServer.
unit Unit1;
interface
uses
IdGlobal,IdContext, system.win.Comobj, system.syncObjs, MSXML2_TLB, activex,
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP, IdCustomTCPServer, IdCustomHTTPServer,
IdHTTPServer, Vcl.ExtCtrls;
Type
TxClientThread = class(TThread)
private
fHttpClient: TIdHTTP;
furl: String;
ftag:Integer;
fResponseXML:String;
fXML: IXMLDOMDocument;
fNode: IXMLDomNode;
protected
procedure Execute; override;
procedure DoTerminate; override; **//Added**
public
constructor Create(atag:Integer;AURL:string);reintroduce;
destructor Destroy; override;
end;
type
TForm1 = class(TForm)
IdTCPServer1: TIdHTTPServer;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure StartTimerAgain;
end;
const
maximumThreads=200;
var
Form1: TForm1;
Threads_downloaded:Integer;
Total_threads:Integer;
FullXML_STR:String;
Clients:TList;
CriticalSection:TCriticalSection;
ClientThread:Array[0..maximumThreads] of TxClientThread;
implementation
{$R *.dfm}
{TxClientThread}
constructor TxClientThread.Create(atag:Integer;AURL:string);
begin
inherited Create(false);
furl:=Aurl;
ftag:=Atag;
fResponseXML:='';
fHttpClient := TIdHTTP.Create(nil);
fHttpClient.Tag:=ftag;
fHttpClient.ConnectTimeout:=60000;
fHttpClient.ReadTimeout:=60000;
fHttpClient.Request.Accept:='*/*';
fHttpClient.Request.UserAgent:='Mozilla/5.0 (Windows NT 6.1; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/73.0.3683.86 Safari/537.36';
FreeOnTerminate := True;
end;
destructor TxClientThread.Destroy;
begin
fHttpClient.Free;
inherited Destroy;
end;
procedure TxClientThread.Execute;
begin
try
fResponseXML:= fHttpClient.Get(furl);
except
end;
end;
procedure TxClientThread.DoTerminate;
begin
inc(Threads_downloaded);
///****** parsing The XML
try
CoInitialize(nil);
fXML := CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
fXML.async := false;
try
fXML.loadXML(fResponseXML);
fNode := fXML.selectSingleNode('/games');
if fNode<>nil then
begin
FullXML_STR:=FullXML_STR + fNode.attributes.getNamedItem('id').text+'^';
end;
finally
fxml:=nil; //---> do i need this?
end;
finally
CoUninitialize;
end;
if Threads_downloaded=Total_threads then
begin
TThread.Synchronize(nil,procedure/////////Sould i USe This or Synchronize
var
i:Integer;
begin
CriticalSection.enter;
if not Assigned(Form1.IdTCPServer1.Contexts) then exit;
try
Clients:=Form1.IdTCPServer1.Contexts.LockList;
try
for i:=pred(Clients.Count) downto 0 do
try
TIdContext(Clients[i]).Connection.IOHandler.Writeln(FullXML_STR,IndyTextEncoding_UTF8);
except
end;
finally
Form1.IdTCPServer1.Contexts.UnlockList;
end;
finally
CriticalSection.leave;
end;
form1.StartTimerAgain; ///Startinmg againe Then timer
end
);
end;
/////////// End \ All threads downloaded
inherited;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CriticalSection:=TCriticalSection.create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CriticalSection.Free;
end;
procedure tform1.StartTimerAgain;
begin
Form1.Timer1.Enabled:=true
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
x:Integer;
aUrl:String;
begin
FullXML_STR:='';
Timer1.Enabled:=false;
Threads_downloaded:=0;
Total_threads=100;
for x:=0 to Pred(Total_threads) do
begin
aUrl:='http://example.com/myxml'+Formatfloat('0',x)+'.xml';
ClientThread[Threads_downloaded]:=TxClientThread.Create(x,aUrl);
end;
end;
end.
main problem is that after 1-2 Hours programm is not responding.
in each thread's Execute(), I check if all Threads have finished downloading. Is there a better way to know that all my threads are finished?
is it better to call Contexts.LockList() on the TIdTCPServer before the timer starts creating the threads, and unlock it after the threads are finished?
What can I do to optimize my code so I can be sure that the timer will be alive all the time? I am restarting the timer after all threads are finished.
Is this the correct way to do it?
Request:
How is it possible to accept a string like hi from a client connected on the TIdTCPServer and send back a string.
I try to add the following code:
var
RxBuf: TIdBytes;
Data := TxClientContext(AContext).ExtractQueuedStrings;
if Data <> nil then
try
for i := 0 to Pred(Data.Count) do
AContext.Connection.IOHandler.WriteLn(Data[i]);
finally
Data.Free;
end;
RxBuf := nil;
with AContext.Connection do
begin
IOHandler.CheckForDataOnSource(100);
if not IOHandler.InputBufferIsEmpty then
begin
InputBuffer.ExtractToBytes(RxBuf); //for TIdBytes
AContext.Connection.IOHandler.WriteLn('hello');
end;
end;
After sending hello the app never sends data from the queue.
How can I add the hello to Data extract from queue?
Something like this:
Data := TxClientContext(AContext).ExtractQueuedStrings;
and then
data.text:=data.text +'hello data';
or how can I add the 'hello data' in the queue?

Answer 1

I see a lot of mistakes in your code. Rather than pointing them out individually, I would suggest just rewritting the entire code, especially since you are also asking for optimizations.
Try something more like this instead:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls,
IdGlobal, IdContext, IdBaseComponent, IdComponent, IdTCPConnection, IdCustomTCPServer,
IdTCPServer, IdThreadSafe;
type
TIdTCPServer = class(IdTCPServer.TIdTCPServer)
protected
procedure DoTerminateContext(AContext: TIdContext); override;
end;
TForm1 = class(TForm)
IdTCPServer1: TIdTCPServer;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure IdTCPServer1Connect(AContext: TIdContext);
procedure IdTCPServer1Execute(AContext: TIdContext);
private
{ Private declarations }
IDs: TIdThreadSafeString;
Threads: TList;
procedure ThreadTerminated(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
System.Win.Comobj, MSXML2_TLB, ActiveX, System.SyncObjs, IdHTTP, IdYarn;
{$R *.dfm}
const
maximumThreads = 100;//200;
{TxClientContext}
type
TxClientContext = class(TIdServerContext)
private
fQueue: TIdThreadSafeStringList;
fInQueue: TEvent;
public
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
procedure AddStringToQueue(const S: string);
function ExtractQueuedStrings: TStrings;
end;
constructor TxClientContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
fQueue := TIdThreadSafeStringList.Create;
fInQueue := TEvent.Create(nil, True, False, '');
end;
destructor TxClientContext.Destroy; override;
begin
fQueue.Free;
fInQueue.Free;
inherited;
end;
procedure TxClientContext.AddStringToQueue(const S: string);
var
List: TStringList;
begin
List := fQueue.Lock;
try
List.Add(S);
fInQueue.SetEvent;
finally
fQueue.Unlock;
end;
end;
function TxClientContext.ExtractQueuedStrings: TStrings;
var
List: TStringList;
begin
Result := nil;
if fInQueue.WaitFor(INFINITE) <> wrSignaled then Exit;
List := FQueue.Lock;
try
if List.Count > 0 then
begin
Result := TStringList.Create;
try
Result.Assign(List);
List.Clear;
except
Result.Free;
raise;
end;
end;
fInQueue.ResetEvent;
finally
fQueue.Unlock;
end;
end;
{TxClientThread}
type
TxClientThread = class(TThread)
private
fURL: String;
protected
procedure Execute; override;
public
GameID: string;
constructor Create(AURL: string; AOnTerminate: TNotifyEvent); reintroduce;
end;
constructor TxClientThread.Create(AURL: string; AOnTerminate: TNotifyEvent);
begin
inherited Create(False);
fURL := AURL;
OnTerminate := AOnTerminate;
FreeOnTerminate := True;
end;
procedure TxClientThread.Execute;
var
HttpClient: TIdHTTP;
ResponseXML: String;
XML: IXMLDOMDocument;
Node: IXMLDomNode;
begin
HttpClient := TIdHTTP.Create(nil);
try
HttpClient.ConnectTimeout := 60000;
HttpClient.ReadTimeout := 60000;
HttpClient.Request.Accept := '*/*';
HttpClient.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/73.0.3683.86 Safari/537.36';
ResponseXML := HttpClient.Get(fURL);
finally
HttpClient.Free;
end;
CoInitialize(nil);
try
XML := CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
try
XML.async := False;
XML.loadXML(ResponseXML);
Node := XML.selectSingleNode('/games');
if Node <> nil then
try
GameID := Node.attributes.getNamedItem('id').text;
finally
Node := nil;
end;
finally
XML := nil;
end;
finally
CoUninitialize;
end;
end;
{TIdTCPServer}
procedure TIdTCPServer.DoTerminateContext(AContext: TIdContext);
begin
inherited; // <-- closes the socket
TxClientContext(AContext).FInQueue.SetEvent; // unblock OnExecute if it is waiting for data...
end;
{TForm1}
procedure TForm1.FormCreate(Sender: TObject);
begin
IdTCPServer1.ContextClass := TxClientContext;
IDs := TIdThreadSafeString.Create;
Threads := TList.Create;
Threads.Capacity := maximumThreads;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
IDs.Free;
Threads.Free;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
x: Integer;
Thread: TxClientThread;
begin
Timer1.Enabled := False;
IDs.Value := '';
for x := 0 to Pred(maximumThreads) do
begin
Thread := TxClientThread.Create('http://example.com/myxml' + IntToStr(x) + '.xml', ThreadTerminated);
try
Threads.Add(TObject(Thread));
except
Thread.Free;
raise;
end;
end;
end;
proccedure TForm1.ThreadTerminated(Sender: TObject);
var
Clients: TList;
s: string;
i: Integer;
begin
try
s := TxClientThread(Sender).GameID;
if s <> '' then IDs.Append(s + '^');
finally
Threads.Remove(Sender);
end;
if (Threads.Count > 0) or (not Assigned(IdTCPServer1.Contexts)) then Exit;
s := IDs.Value;
if s = '' then Exit;
Clients := IdTCPServer1.Contexts.LockList;
try
for i := Pred(Clients.Count) downto 0 do
try
TxClientContext(TIdContext(Clients[i])).AddStringToQueue(s);
except
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
Timer1.Enabled := True;
end;
procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
begin
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
Data: TStrings;
i: Integer;
begin
Data := TxClientContext(AContext).ExtractQueuedStrings;
if Data <> nil then
try
for i := 0 to Pred(Data.Count) do
AContext.Connection.IOHandler.WriteLn(Data[i]);
finally
Data.Free;
end;
end;
end.

Answer 2

In each thread, you add the resulting string into a global variable. That is not a safe operation. Instead, add an OnTerminate handler to your threads, where you add the result and also can keep track of the threads.
This is safe, since the OnTerminate handler is executed in the main thread.
I suggest to pass a callback method to pass the result. It is declared like:
type
TSyncMethod = procedure(const ReturnValue: String) of object;
Change the thread accordingly:
Type
TxClientThread = class(TThread)
private
furl : String;
ftag : Integer;
fCallbackMethod : TSyncMethod;
fXMLResult : String;
procedure AfterWork(Sender : TObject);
...
public
constructor Create(atag: Integer; AURL: string; CallbackMethod : TSyncMethod); reintroduce;
...
end;
Add a callback method to your form:
Type
TForm1 = Class(TForm1)
private
// Put your "global" variables here
Threads_downloaded : Integer;
Total_threads : Integer;
FullXML_STR : String;
procedure ManageThreadReturnValue(const ReturnValue : String); // Callback from threads
...
end;
The implementation part:
constructor TxClientThread.Create(atag: Integer; AURL: string; CallbackMethod : TSyncMethod);
begin
inherited Create(false);
furl := Aurl;
ftag := Atag;
fCallbackMethod := CallbackMethod;
fXMLResult := '';
OnTerminate := AfterWork; // Execute AfterWork when thread terminates (in main thread)
FreeOnTerminate := True;
end;
procedure TxClientThread.Execute;
var
lHttpClient : TIdHTTP;
lResponseXML :String;
lXML : IXMLDOMDocument;
lNode : IXMLDomNode;
begin
lHttpClient := TIdHTTP.Create(nil);
try
lHttpClient.Tag := ftag;
lHttpClient.ConnectTimeout := 60000;
lHttpClient.ReadTimeout := 60000;
lHttpClient.Request.Accept := '*/*';
lHttpClient.Request.UserAgent :=
'Mozilla/5.0 (Windows NT 6.1; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/73.0.3683.86 Safari/537.36';
try
lResponseXML:= lHttpClient.Get(fUrl);
except
end;
finally
lHttpClient.Free;
end;
///****** parsing The XML
CoInitialize(nil);
try
lXML := CreateOleObject('Microsoft.XMLDOM') as IXMLDOMDocument;
lXML.async := false;
try
lXML.loadXML(lResponseXML);
lNode := lXML.selectSingleNode('/games');
if lNode<>nil then
begin
fXMLResult := lNode.attributes.getNamedItem('id').text+'^';
end;
finally
lnode := nil;
lxml := nil; //---> Q: do i need this?
//---> A: Yes, it must be finalized before CoUnitialize
end;
finally
CoUninitialize;
end;
end;
procedure TxClientThread.AfterWork;
begin
if Assigned(fCallbackMethod) then
fCallbackMethod(fXMLResult); // Pass data
end;
procedure TForm1.ManageThreadReturnValue(const ReturnValue : String);
var
i : Integer;
Clients : TList;
begin
// Take care of the return value and other things related to
// what happens when a thread ends.
FullXML_STR := FullXML_STR + ReturnValue;
Inc(threads_downloaded);
if Threads_downloaded = Total_threads then
begin
if Assigned(IdTCPServer1.Contexts) then
begin
Clients:= IdTCPServer1.Contexts.LockList;
try
for i:= Pred(Clients.Count) downto 0 do
begin
try
TIdContext(Clients[i]).Connection.IOHandler.Writeln(
FullXML_STR,IndyTextEncoding_UTF8);
except
end;
end;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
StartTimerAgain; ///Starting again The timer
end;
end;
// Initiate threads
FullXML_STR:='';
Timer1.Enabled:=false;
Threads_downloaded:=0;
Total_threads=100;
for x:= 0 to Pred(Total_threads) do
begin
aUrl:='http://example.com/myxml'+Formatfloat('0',x)+'.xml';
TxClientThread.Create(x,aUrl,ManageThreadReturnValue); // !! Never keep a reference to a thread with FreeOnTerminate = true
end;
Some other hints:
Put your global variables into the private section of TForm1. This is the place where they belong.
Remove the ClientThread array, since a reference to a thread with FreeOnTerminate = true should never be used.
Do not swallow exceptions, i.e. empty except end clauses are not a good practice.
By using the callback method, you decouple the thread from code/data that does not belong to the thread. That is one of the most important lessons to learn when programming (i.e. avoid making spaghetti code).