Fatal编程技术网
  • delphi/
  • 印地10号+；Delphi客户端服务器应用程序占用所有CPU

印地10号+；Delphi客户端服务器应用程序占用所有CPU

delphi

印地10号+；Delphi客户端服务器应用程序占用所有CPU,delphi,client-server,indy10,Delphi,Client Server,Indy10,我编写了一个小型客户机-服务器应用程序，它运行在两台或更多不同的机器上，用于重新启动/关闭。由于我对客户机-服务器应用程序比较陌生，所以我选择了。很快，我的服务器应用程序将在端口7676上等待连接，将客户端添加到客户端列表，然后不执行任何操作（稍后将执行关闭和重新启动过程）。然而，即使它是被动的，在只有两个客户端连接的情况下，它也会占用高达90%的CPU。以下是客户端代码，由一个TidTCPServer和一个TIDT防冻剂组成： type PClient = ^TClient; TC

我编写了一个小型客户机-服务器应用程序，它运行在两台或更多不同的机器上，用于重新启动/关闭。由于我对客户机-服务器应用程序比较陌生，所以我选择了。很快，我的服务器应用程序将在端口7676上等待连接，将客户端添加到客户端列表，然后不执行任何操作（稍后将执行关闭和重新启动过程）。然而，即使它是被动的，在只有两个客户端连接的情况下，它也会占用高达90%的CPU。以下是客户端代码，由一个TidTCPServer和一个TIDT防冻剂组成：

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;
idTCPServer组件的设置如下：ListenQueue:=15，MaxConnections:=0，TerminateWaitTime:5000

我做错什么了吗？为了同时支持30-40个客户，我应该采取不同的方法吗

谢谢， Bob.

在
TCPServerExecute（）
中，您没有初始化
命令

您不应该在
StartServerExecute（）
中释放
绑定。相反，请尝试以下方法：


var
  sh: TidSocketHandle;
begin
  sh := TCPServer.Bindings.Add;
  sh.IP := DefaultServerIP;
  sh.Port := DefaultServerPort;


什么是启动服务器执行（）

不幸的是，代码有太多的问题，太多的代码丢失，无法猜测发生了什么。
在
TCPServerExecute（）
中，您没有初始化
命令

您不应该在
StartServerExecute（）
中释放
绑定。相反，请尝试以下方法：


var
  sh: TidSocketHandle;
begin
  sh := TCPServer.Bindings.Add;
  sh.IP := DefaultServerIP;
  sh.Port := DefaultServerPort;


什么是启动服务器执行（）


不幸的是，代码有太多的问题，太多的代码丢失，无法猜测发生了什么。
您的CPU语言被挂起的原因是因为您的
OnExecute
事件处理程序实际上没有做任何事情，因此，每个连接线程都有效地运行一个紧密循环，不会向等待CPU时间的其他线程产生CPU时间片。您需要在该事件处理程序中有一个让步操作。一旦您实现了实际的命令，该命令将由
ReadLn（）
为您处理，但在实现之前，您可以使用调用
IndySleep（）
，例如：


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; 


话虽如此，代码中还有一些其他问题，例如误用
TIdSocketHandles
、线程安全问题等。请尝试以下方法：


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; 



使用
…，IdContext，IdSync；
//...
类型
PClient=^TClient；
TClient=记录
PeerIP：字符串；{客户端IP地址}
主机名：字符串；{Hostname}
已连接：TDateTime；{连接时间}
最后一个动作：TDateTime；{上次交易时间}
文本：上下文；{指向线程的指针}
终止
//...
过程TForm1.StartServerExecute（发送方：TObject）；
开始
//设置并启动TCPServer
TCPServer.Bindings.Clear；
使用TCPServer.Bindings.Add do
开始
IP:=默认服务器IP；
端口：=默认服务器端口；
终止
TCPServer.Active:=True；
//设置TCPServer
//其他启动设置
Protocol.Items.Add（TimeToStr（Time）+运行在'+TCPServer.Bindings[0].IP+'：'+IntToStr（TCPServer.Bindings[0].Port]上的关闭服务器）；
刷新列表显示；
终止
程序TForm1.RefreshListDisplay；
变量
名单:TList ;；
I：整数；
客户：PClient；
开始
//根据需要清除显示列表。。。
列表：=TCPServer.Contexts.LockList；
尝试
对于I:=0到List.Count-1 do
开始
客户：=PClient（TIdContext（列表[I]）。数据）；
如果客户端为零，则
开始
//根据需要将客户端添加到显示列表中。。
终止
终止
最后
TCPServer.Contexts.UnlockList；
终止
终止
类型
TProtocolNotify=class（tidtnotify）
受保护的
FStr：字符串；
程序提示；推翻
平民的
类过程添加（常量AStr:String）；
终止
程序TProtocolNotify.DoNotify；
开始
表1.协议项添加（FStr）；
终止
类过程TProtocolNotify.Add（const AStr:String）；
开始
用Create do
开始
FStr:=AStr；
通知
终止
终止
类型
TRefreshListNotify=类（TIdNotify）
受保护的
程序提示；推翻
平民的
类程序刷新；
终止
程序TRefreshListNotify.DoNotify；
开始
Form1.1刷新列表显示；
终止
类过程TRefreshListNotify.Refresh；
开始
创建、通知；
终止
过程TForm1.TCPServerConnect（AContext:TIdContext）；
变量
新客户：PClient；
开始
GetMem（NewClient，SizeOf（TClient））；
尝试
NewClient.PeerIP:=AContext.Connection.Socket.Binding.PeerIP；
NewClient.HostName:=GStack.HostByAddress（NewClient.PeerIP）；
NewClient.Connected:=现在；
NewClient.LastAction:=NewClient.Connected；
NewClient.AContext:=AContext；
AContext.Data:=TObject（NewClient）；
除了
FreeMem（新客户）；
提升
终止
TProtocolNotify.Add（TimeToStr（Time）+连接来自“+NewClient.HostName+”，连接来自“+NewClient.PeerIP”）；
TRefreshListNotify.Refresh；
终止
过程TForm1.TCPServerDisconnect（AContext:TIdContext）；
变量
客户：PClient；
开始
客户端：=PClient（AContext.Data）；
TProtocolNotify.Add（TimeToStr（Time）+“Client”+“Client.HostName+”“++“disconnected”）；
FreeMem（客户）；
AContext.Data:=nil；
TRefreshListNotify.Refresh；
终止
过程TForm1.TCPServerExecute（AContext:TIdContext）；
变量
客户：PClient；
命令：字符串；
//PicturePathName：字符串；
ftmpStream:TFileStream；
开始
客户端：=PClient（AContext.Data）；
Client.LastAction:=现在；
//命令：=AContext.Connection.ReadLn；
IndySleep（10）；
如果Command='CheckMe'，则
开始
{在这里做任何必要的事情}
终止
终止

您的CPU语言被挂起的原因是因为您的
OneExecute
事件处理程序实际上没有做任何事情，因此每个连接线程实际上都在运行一个紧密循环，不会向等待CPU时间的其他线程生成CPU时间片。您需要在该事件处理程序中有一个让步操作。一旦你实现你