Board index » delphi » TCPServer using 100% CPU time

2004-05-03 10:10:09 PM
delphi110
Hi,
I have a TCP Server application built using TidTCPServer. This application
handles clients connections and those clients weren't made using Indy. The
Server must keep clients connections to be able to send messages back to
then, not only as responses to clients answers. Everything is going fine.
There is only one problem: The clients doesn't always disconnect gracefully.
So I tried to put a Timer that checks if the clients last message is greater
then 60 seconds. If so the server disconnects the client. Most of the time
it works fine. But sometimes, something gets wrong and the Server start to
use nearly 100% of CPU time. The server doesn't stop it can continue to talk
with the remaining clients. But the machine speed get very slow.
Does anyone knows how can I solve this?
Thanks
Marcelo Rodrigues
 

Sounds like you have some tight while loops without a sleep.
while bla>1000 do
begin
//your loop code here
sleepex(0,true); //or sleepex(1,true)
end;
 

"Marcelo Rodrigues" <XXXX@XXXXX.COM>writes
client and server code.
yielding control to other threads. Please show your actual code.
Gambit
 

Hi,
Following is how my timer procedure goes:
procedure TfrmMainSrv.tmPingTimer(Sender: TObject);
var
List : TList;
lcObject : TXGObject;
i : integer;
begin
tmPing.Enabled := false;
StatusBar1.Panels[1].Text := 'checking threads';
application.ProcessMessages;
List := Server.Threads.LockList;
try
for i := 0 to List.Count - 1 do
begin
lcObject := TXGObject( TIdPeerThread( List.Items[i] ).Data );
if Assigned( lcObject ) then
begin
if SecondsBetween(now, lcObject.LastUpdate)>90 then
begin
try
lcObject.PeerThread := nil;
lcObject.State := msOffLine;
AddToLogView('Removed',Format('Client disconnected
%d',[lcObject.id]),now,4);
TIdPeerThread( List.Items[i] ).Connection.DisconnectSocket;
except
lcObject .PeerThread := nil;
lcObject .State := msOffLine;
AddToLogView('ERROR',Format('Trying to disconnect
clinet%d',[lcObject.id]),now,3);
TIdPeerThread( List.Items[i] ).Stop;
end;
lcObject := nil;
end;
end;
end;
finally
Server.Threads.UnlockList;
StatusBar1.Panels[1].Text := '';
tmPing.Enabled := true;
end;
end;
Thanks
Marcelo
"Remy Lebeau (TeamB)" <XXXX@XXXXX.COM>escreveu na
mensagem news:40968cd2$XXXX@XXXXX.COM...

"Marcelo Rodrigues" <XXXX@XXXXX.COM>writes
timeouts? You appear to already have the PeerThread keeping track of the
last received packet, so just do your checking in OnExecute itself and then
disconnect the socket when needed. For example:
procedure TfrmMainSrv.ServerExecute(AThread: TIdPeerThread);
var
lcObject : TXGObject;
begin
lcObject := TXGObject( AThread.Data );
//...
if SecondsBetween(now, lcObject.LastUpdate)>90 then
begin
lcObject.PeerThread := nil;
lcObject.State := msOffLine;
AThread.Connection.DisconnectSocket;
end;
//...
end;
Gambit
 

Thanks,
I will try this aproach and let you know if it suceeded.
Marcelo
"Remy Lebeau (TeamB)" <XXXX@XXXXX.COM>escreveu na
mensagem news:4096a617$XXXX@XXXXX.COM...

Hi,
It works. But I tried it with just one connection. Now I will try with lots
of clients.
Thank you very much.
BTW. I use the same aproach to quit the application like following, and
sometimes it gives me errors. Is it the correct way to quit the application?
procedure TfrmMainSrv.FormClose(Sender: TObject; var Action: TCloseAction);
var
List: TList;
I: Integer;
begin
List := Server.Threads.LockList;
try
for I := 0 to List.Count - 1 do
begin
try
TIdPeerThread(List.Items[I]).Connection.DisconnectSocket;
except
on E: Exception do
begin
AddToLogView('ERROR','Thread stoped',now,3);
AddToLogView('ERROR','Erro (' + FormatDateTime('dd/mm/yyyy', Now)
+ ') [' + E.ClassName + ']: ' + E.Message,now,3);
TIdPeerThread(List.Items[I]).Stop;
end; //on
end; //try
end; //for
finally
Server.Threads.UnlockList;
end;
ObjectList.Free;
Server.TerminateWaitTime := 20000;
Server.Active := false;
end;
Marcelo
"Remy Lebeau (TeamB)" <XXXX@XXXXX.COM>escreveu na
mensagem news:4096a617$XXXX@XXXXX.COM...

"Marcelo Rodrigues" <XXXX@XXXXX.COM>writes
You should not have to do any of that to begin with. Just set the server's
Active property to false, it will do all of that stuff internally for you.
procedure TfrmMainSrv.FormClose(Sender: TObject; var Action:
TCloseAction);
begin
Server.Active := false;
ObjectList.Free;
end;
Gambit
 

Thanks.
"Remy Lebeau (TeamB)" <XXXX@XXXXX.COM>escreveu na
mensagem news:4096be5e$XXXX@XXXXX.COM...