Indy 10 + Delphi客户端 - 服务器应用程序占用所有CPU [英] Indy 10 + Delphi Client-Server App Eats up all CPU
本文介绍了Indy 10 + Delphi客户端 - 服务器应用程序占用所有CPU的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我写了一个小型客户端 - 服务器应用程序，在两个或更多不同的机器上运行，用于重新启动/关闭。由于我是客户端 - 服务器应用程序的新手，因此我在关于Delphi方法。很快，我的服务器应用程序等待端口7676上的连接，将客户端添加到客户端列表，然后什么也不做（稍后将实现关闭和重新启动过程）。然而，即使它是被动的，它占用高达90％的CPU，只有两个客户端连接。这里是由TidTCPServer和TidAntiFreeze组成的客户端代码：
type
PClient = ^ TClient;
TClient = record
PeerIP：string [15]; {Client IP address}
HostName：String [40]; {Hostname}
已连接，{连接时间}
LastAction：TDateTime; {上次事务的时间}
AContext：Pointer; {指向线程}
end;
[...]
procedure TForm1.StartServerExecute（Sender：TObject）;
var
绑定：TIdSocketHandles;
begin
//设置并启动TCPServer
Bindings：= TIdSocketHandles.Create（TCPServer）;
try
with Bindings.Add do
begin
IP：= DefaultServerIP;
Port：= DefaultServerPort;
end;
try
TCPServer.Bindings：= Bindings;
TCPServer.Active:=True;
except on E：Exception do
ShowMessage（E.Message）;
end;
finally
Bindings.Free;
end;
//设置TCPServer
//其他启动设置
客户端：= TThreadList.Create;
Clients.Duplicates：= dupAccept;
RefreshListDisplay;
如果TCPServer.Active然后
begin
Protocol.Items.Add（TimeToStr（Time）+'关闭服务器运行'+ TCPServer.Bindings [0] .IP + ：'+ IntToStr（TCPServer.Bindings [0] .Port））;
end;
end;
procedure TForm1.TCPServerConnect（AContext：TIdContext）;
var
NewClient：PClient;
begin
GetMem（NewClient，SizeOf（TClient））;
NewClient.PeerIP：= AContext.Connection.Socket.Binding.PeerIP;
NewClient.HostName：= GStack.HostByAddress（NewClient.PeerIP）;
NewClient.Connected：= Now;
NewClient.LastAction：= NewClient.Connected;
NewClient.AContext：= AContext;
AContext.Data：= TObject（NewClient）;
try
Clients.LockList.Add（NewClient）;
finally
Clients.UnlockList;
end;
Protocol.Items.Add（TimeToStr（Time）+'Connection from''+ NewClient.HostName +'from'+ NewClient.PeerIP）;
RefreshListDisplay;
end;
procedure TForm1.TCPServerDisconnect（AContext：TIdContext）;
var
客户端：PClient;
begin
Client：= PClient（AContext.Data）;
Protocol.Items.Add（TimeToStr（Time）+'Client''+ Client.HostName +''+'disconnected'。
try
Clients.LockList.Remove（Client）;
finally
Clients.UnlockList;
end;
FreeMem（Client）;
Acontext.Data：= nil;
RefreshListDisplay;
end;
procedure TForm1.TCPServerExecute（AContext：TIdContext）;
var
客户端：PClient;
命令：string;
// PicturePathName：string;
ftmpStream：TFileStream;
begin
如果不是AContext.Connection.Connected然后
begin
Client：= PClient（AContext.Data）;
Client.LastAction：= Now;
//命令：= AContext.Connection.ReadLn;
if Command ='CheckMe'then
begin
{在这里做任何必要}
end;
end;
end;
idTCPServer组件设置如下：ListenQueue：= 15，MaxConnections：= 0，TerminateWaitTime：5000 。
我在这里做错了吗？
感谢，
Bob。
<因为你的
OnExecute 事件处理程序实际上没有做任何事情，所以每个连接线程正在有效地运行一个紧凑的循环，不会产生CPU时间片给正在等待CPU时间的其他线程。您需要在该事件处理程序中有一个yield操作。一旦你实现了你的实际命令，该收益将由 ReadLn（）处理，但直到你实现，那么你可以使用 IndySleep（），例如： procedure TForm1.TCPServerExecute（AContext：TIdContext）;
var
客户端：PClient;
命令：string;
// PicturePathName：string;
ftmpStream：TFileStream;
begin
Client：= PClient（AContext.Data）;
Client.LastAction：= Now;
//命令：= AContext.Connection.ReadLn;
IndySleep（10）;
// ...
end;
现在，说到这里，你的代码还有一些其他问题，例如滥用 TIdSocketHandles ，线程安全问题等。尝试这样：
使用
...，IdContext，IdSync;
// ...
类型
PClient = ^ TClient;
TClient = record
PeerIP：String; {客户端IP地址}
HostName：String; {Hostname}
Connected：TDateTime; {连接时间}
LastAction：TDateTime; {上次事务的时间}
AContext：TIdContext; {指向线程}
end;
// ...
procedure TForm1.StartServerExecute（Sender：TObject）;
begin
//设置并启动TCPServer
TCPServer.Bindings.Clear;
with TCPServer.Bindings.Add do
begin
IP：= DefaultServerIP;
Port：= DefaultServerPort;
end;
TCPServer.Active：= True;
//设置TCPServer
//其他启动设置
Protocol.Items.Add（TimeToStr（Time）+'Shutdown server running on'+ TCPServer.Bindings [0]。 IP +'：'+ IntToStr（TCPServer.Bindings [0] .Port））;
RefreshListDisplay;
end;
procedure TForm1.RefreshListDisplay;
var
List：TList;
I：Integer;
客户：PClient;
begin
//根据需要清除显示列表...
List：= TCPServer.Contexts.LockList;
try
for I：= 0 to List.Count-1 do
begin
Client：= PClient（TIdContext（List [I]）。
if Client<> nil then
begin
//根据需要添加客户端到显示列表。
end;
end;
finally
TCPServer.Contexts.UnlockList;
end;
end;
type
TProtocolNotify = class（TIdNotify）
protected
FStr：String;
procedure DoNotify;覆盖;
public
类过程Add（const AStr：String）;
end;
过程TProtocolNotify.DoNotify;
begin
Form1.Protocol.Items.Add（FStr）;
end;
类过程TProtocolNotify.Add（const AStr：String）;
begin
with Create do
begin
FStr：= AStr;
通知;
end;
end;
type
TRefreshListNotify = class（TIdNotify）
protected
procedure DoNotify;覆盖;
public
类过程刷新;
end;
procedure TRefreshListNotify.DoNotify;
begin
Form1.RefreshListDisplay;
end;
类过程TRefreshListNotify.Refresh;
begin
Create.Notify;
end;
procedure TForm1.TCPServerConnect（AContext：TIdContext）;
var
NewClient：PClient;
begin
GetMem（NewClient，SizeOf（TClient））;
try
NewClient.PeerIP：= AContext.Connection.Socket.Binding.PeerIP;
NewClient.HostName：= GStack.HostByAddress（NewClient.PeerIP）;
NewClient.Connected：= Now;
NewClient.LastAction：= NewClient.Connected;
NewClient.AContext：= AContext;
AContext.Data：= TObject（NewClient）;
except
FreeMem（NewClient）;
raise;
end;
TProtocolNotify.Add（TimeToStr（Time）+'Connection from''+ NewClient.HostName +'from'+ NewClient.PeerIP）;
TRefreshListNotify.Refresh;
end;
procedure TForm1.TCPServerDisconnect（AContext：TIdContext）;
var
客户端：PClient;
begin
Client：= PClient（AContext.Data）;
TProtocolNotify.Add（TimeToStr（Time）+'Client''+ Client.HostName +''+'disconnected'。
FreeMem（Client）;
AContext.Data：= nil;
TRefreshListNotify.Refresh;
end;
procedure TForm1.TCPServerExecute（AContext：TIdContext）;
var
客户端：PClient;
命令：string;
// PicturePathName：string;
ftmpStream：TFileStream;
begin
Client：= PClient（AContext.Data）;
Client.LastAction：= Now;
//命令：= AContext.Connection.ReadLn;
IndySleep（10）;
如果Command ='CheckMe'then
begin
{在这里做任何必要}
end;
end;
I wrote a small client-server application that runs on two or more distinct machines for reboot / shutdown purposes. Since I'm relatively new to client-server apps, I took the About Delphi approach here. Shortly put, my server app awaits connections on port 7676, adds the client to a client list then does nothing (will implement the shutdown and restart procedures later). However, even if it's passive, it eats up to 90% of CPU with only two clients connected. Here's the client code, made up of an TidTCPServer and a TidAntiFreeze:
type
PClient = ^TClient;
TClient = record
PeerIP : string[15]; { Client IP address }
HostName : String[40]; { Hostname }
Connected, { Time of connect }
LastAction : TDateTime; { Time of last transaction }
AContext : Pointer; { Pointer to thread }
end;
[...]
procedure TForm1.StartServerExecute(Sender: TObject);
var
Bindings: TIdSocketHandles;
begin
//setup and start TCPServer
Bindings := TIdSocketHandles.Create(TCPServer);
try
with Bindings.Add do
begin
IP := DefaultServerIP;
Port := DefaultServerPort;
end;
try
TCPServer.Bindings:=Bindings;
TCPServer.Active:=True;
except on E:Exception do
ShowMessage(E.Message);
end;
finally
Bindings.Free;
end;
//setup TCPServer
//other startup settings
Clients := TThreadList.Create;
Clients.Duplicates := dupAccept;
RefreshListDisplay;
if TCPServer.Active then
begin
Protocol.Items.Add(TimeToStr(Time)+' Shutdown server running on ' + TCPServer.Bindings[0].IP + ':' + IntToStr(TCPServer.Bindings[0].Port));
end;
end;
procedure TForm1.TCPServerConnect(AContext: TIdContext);
var
NewClient: PClient;
begin
GetMem(NewClient, SizeOf(TClient));
NewClient.PeerIP := AContext.Connection.Socket.Binding.PeerIP;
NewClient.HostName := GStack.HostByAddress(NewClient.PeerIP);
NewClient.Connected := Now;
NewClient.LastAction := NewClient.Connected;
NewClient.AContext := AContext;
AContext.Data := TObject(NewClient);
try
Clients.LockList.Add(NewClient);
finally
Clients.UnlockList;
end;
Protocol.Items.Add(TimeToStr(Time)+' Connection from "' + NewClient.HostName + '" from ' + NewClient.PeerIP);
RefreshListDisplay;
end;
procedure TForm1.TCPServerDisconnect(AContext: TIdContext);
var
Client: PClient;
begin
Client := PClient(AContext.Data);
Protocol.Items.Add (TimeToStr(Time)+' Client "' + Client.HostName+'"' + ' disconnected.');
try
Clients.LockList.Remove(Client);
finally
Clients.UnlockList;
end;
FreeMem(Client);
AContext.Data := nil;
RefreshListDisplay;
end;
procedure TForm1.TCPServerExecute(AContext: TIdContext);
var
Client : PClient;
Command : string;
//PicturePathName : string;
ftmpStream : TFileStream;
begin
if not AContext.Connection.Connected then
begin
Client := PClient(AContext.Data);
Client.LastAction := Now;
//Command := AContext.Connection.ReadLn;
if Command = 'CheckMe' then
begin
{do whatever necessary in here}
end;
end;
end;
The idTCPServer component is set as follows: ListenQueue := 15, MaxConnections := 0, TerminateWaitTime: 5000.
Am I doing something wrong here? Should I take a different approach in order to support some 30 - 40 clients at once?
Thanks, Bob.
解决方案
The reason your CPU uage is pegged is because your OnExecute event handler is not actually doing anything, so each connection thread is effectively running a tight loop that does not yield CPU timeslices to other threads that are waiting for CPU time. You need to have a yielding operation in that event handler. Once you implement your actual commands, that yielding will be handled by ReadLn() for you, but until you implement that then you can use a call to IndySleep() instead, eg:
procedure TForm1.TCPServerExecute(AContext: TIdContext);
var
Client : PClient;
Command : string;
//PicturePathName : string;
ftmpStream : TFileStream;
begin
Client := PClient(AContext.Data);
Client.LastAction := Now;
//Command := AContext.Connection.ReadLn;
IndySleep(10);
//...
end;
Now, with that said, there are some other issues in your code, such as misuse of TIdSocketHandles, thread safety issues, etc. Try this instead:
uses
..., IdContext, IdSync;
//...
type
PClient = ^TClient;
TClient = record
PeerIP : String; { Client IP address }
HostName : String; { Hostname }
Connected : TDateTime; { Time of connect }
LastAction : TDateTime; { Time of last transaction }
AContext : TIdContext; { Pointer to thread }
end;
//...
procedure TForm1.StartServerExecute(Sender: TObject);
begin
//setup and start TCPServer
TCPServer.Bindings.Clear;
with TCPServer.Bindings.Add do
begin
IP := DefaultServerIP;
Port := DefaultServerPort;
end;
TCPServer.Active := True;
//setup TCPServer
//other startup settings
Protocol.Items.Add(TimeToStr(Time) + ' Shutdown server running on ' + TCPServer.Bindings[0].IP + ':' + IntToStr(TCPServer.Bindings[0].Port));
RefreshListDisplay;
end;
procedue TForm1.RefreshListDisplay;
var
List: TList;
I: Integer;
Client: PClient;
begin
// clear display list as needed...
List := TCPServer.Contexts.LockList;
try
for I := 0 to List.Count-1 do
begin
Client := PClient(TIdContext(List[I]).Data);
if Client <> nil then
begin
// add Client to display list as needed..
end;
end;
finally
TCPServer.Contexts.UnlockList;
end;
end;
type
TProtocolNotify = class(TIdNotify)
protected
FStr: String;
procedure DoNotify; override;
public
class procedure Add(const AStr: String);
end;
procedure TProtocolNotify.DoNotify;
begin
Form1.Protocol.Items.Add(FStr);
end;
class procedure TProtocolNotify.Add(const AStr: String);
begin
with Create do
begin
FStr := AStr;
Notify;
end;
end;
type
TRefreshListNotify = class(TIdNotify)
protected
procedure DoNotify; override;
public
class procedure Refresh;
end;
procedure TRefreshListNotify.DoNotify;
begin
Form1.RefreshListDisplay;
end;
class procedure TRefreshListNotify.Refresh;
begin
Create.Notify;
end;
procedure TForm1.TCPServerConnect(AContext: TIdContext);
var
NewClient: PClient;
begin
GetMem(NewClient, SizeOf(TClient));
try
NewClient.PeerIP := AContext.Connection.Socket.Binding.PeerIP;
NewClient.HostName := GStack.HostByAddress(NewClient.PeerIP);
NewClient.Connected := Now;
NewClient.LastAction := NewClient.Connected;
NewClient.AContext := AContext;
AContext.Data := TObject(NewClient);
except
FreeMem(NewClient);
raise;
end;
TProtocolNotify.Add(TimeToStr(Time) + ' Connection from "' + NewClient.HostName + '" from ' + NewClient.PeerIP);
TRefreshListNotify.Refresh;
end;
procedure TForm1.TCPServerDisconnect(AContext: TIdContext);
var
Client: PClient;
begin
Client := PClient(AContext.Data);
TProtocolNotify.Add(TimeToStr(Time) + ' Client "' + Client.HostName+'"' + ' disconnected.');
FreeMem(Client);
AContext.Data := nil;
TRefreshListNotify.Refresh;
end;
procedure TForm1.TCPServerExecute(AContext: TIdContext);
var
Client : PClient;
Command : string;
//PicturePathName : string;
ftmpStream : TFileStream;
begin
Client := PClient(AContext.Data);
Client.LastAction := Now;
//Command := AContext.Connection.ReadLn;
IndySleep(10);
if Command = 'CheckMe' then
begin
{do whatever necessary in here}
end;
end;
这篇关于Indy 10 + Delphi客户端 - 服务器应用程序占用所有CPU的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
