TIdTcpServer 和 TIdTCPClient 之间的速度交换数据就像洪水一样如何

分类：编程问答

如何解决TIdTcpServer 和 TIdTCPClient 之间的速度交换数据就像洪水一样如何

我有一个简单的 TidTCPServer 在控制台上工作并接受数据。我的问题是当客户端发送流但交换数据的速度非常快时，服务器在 70 行后冻结，服务器的 CPU 负载达到 70%；我不知道如何在每次发送之间不添加睡眠的情况下解决。下面是 Client 和 Server 的示例。你能帮我解决这个问题吗（服务器端）谢谢。

program Srv;

{$I Synopse.inc}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,{$ENDIF}{$ENDIF}
  Classes,SysUtils,CustApp,Generics.Collections,IdTCPServer,IdCustomTCPServer,IdContext,IdGlobal,Db,mORMot,mORMotSQLite3,IdSync,functions,SynCommons,SynSQLite3Static;

type

  { TMyApplication }
  TMyApplication = class(TCustomApplication)

   var IdTCPServer: TIdTCPServer;

   protected
    procedure DoRun; override;
    procedure ServerOnConnect(AContext: TIdContext);
    procedure ServerOnExecute(AContext: TIdContext);
    function ReceiveStream(AContext: TIdContext;Size:integer; var AStream: TStream);

  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;

  type
    TLog = class(TIdNotify)
    protected
      FMsg: string;
      procedure DoNotify; override;
    public
      class procedure LogMsg(const AMsg: string);
    end;

{ TMyApplication }

    procedure TLog.DoNotify;
    var i:integer;
    begin
     writeln(FMsg);
    end;

    class procedure TLog.LogMsg(const AMsg: string);
    begin
      with TLog.Create do
      try
        FMsg := AMsg;
        Notify;
      except
        Free;
        raise;
      end;
    end;

function TMyApplication.ReceiveStream(AContext: TIdContext; var AStream: TStream)
  : Boolean; overload;
var
  LSize: LongInt;
begin
  Result := True;
  try
    LSize := AContext.Connection.IOHandler.ReadLongInt();
    AContext.Connection.IOHandler.ReadStream(AStream,LSize,False)
    AStream.Seek(0,soFromBeginning);
  except
    Result := False;
  end;
end;      

procedure TMyApplication.ServerOnExecute(AContext: TIdContext);
var AStream:TMemoryStream;
begin

if (Acontext.Connection.IOHandler.InputBufferIsEmpty) then
  begin
    TLog.LogMsg('--: '+random(100000).ToString); //After executing Client this line is displayed 70 time and CPU load is from 40 % to 70%
    AStream:=TMemoryStream.Create;
    try 
      ReceiveStream(AContext,TStream(AStream)); 
      // .. here we use AStream to execute some stuff  
    finally
      Astream.free;
    end;        
end;

procedure TMyApplication.ServerOnConnect(AContext: TIdContext);
begin
 TLog.LogMsg('connect');        
end;

procedure TMyApplication.DoRun;
begin

    IdTCPServer := tIdTCPServer.Create;
    IdTCPServer.ListenQueue := 15;
    IdTCPServer.MaxConnections := 0;
    IdTCPServer.TerminateWaitTime := 5000;
    with IdTCPServer.Bindings.Add
    do begin
      IP   := '0.0.0.0';
      Port := 80;
      IPVersion:=Id_IPv4;
    end;
    IdTCPServer.OnConnect := ServerOnConnect;
    IdTCPServer.OnDisconnect := ServerOnDiconnect;
    IdTCPServer.OnExecute := ServerOnExecute;
    IdTCPServer.Active := True;

  while true do
   begin
    Classes.CheckSynchronize() ;
    sleep(10);
   end;

  readln;        

  Terminate;
end;

constructor TMyApplication.Create(TheOwner: TComponent);
begin

  inherited Create(TheOwner);
  StopOnException := True;

end;


destructor TMyApplication.Destroy;
begin
  IdTCPServer.Free;
  inherited Destroy;

end;

var
  Application: TMyApplication;
begin
  Application := TMyApplication.Create(nil);
  Application.Title := 'My Application';
  Application.Run;
  Application.Free;
end.

客户



function TForm1.SendStream(AClient: TIdTCPClient; AStream: TStream): Boolean; overload;
var
  StreamSize: LongInt;
begin
  try
    Result := True;
    try
      AStream.Seek(0,soFromBeginning);
      StreamSize := (AStream.Size);
      AClient.IOHandler.Write(LongInt(StreamSize));
      AClient.IOHandler.WriteBufferOpen;
      AClient.IOHandler.Write(AStream,False);
      AClient.IOHandler.WriteBufferFlush;
    finally
      AClient.IOHandler.WriteBufferClose;
    end;
  except
    Result := False;
  end;
end;   
    
procedure TForm1.Button1Click(Sender: TObject);
var 
  Packet:TPacket;
  AStream:TMemoryStream;
begin
for i:=0 to 1000 do 
  begin
    Application.ProcessMessages;
    With Packet do
                 begin
                   MX               := random(10000);
                   MY               := random(10000);
                 end;
     AStream:=TMemoryStream.Create;
     try
        AStream.Write(Packet,SizeOf(TPacket));
        SendStream(IdTCPClientCmd,TStream(AStream));
     finally
        AStream.Free;
     end;
  end;

end;

解决方法

在服务器端，您的 InputBufferIsEmpty() 检查是反向的。如果客户端发送大量数据，InputBufferIsEmpty() 最终可能会变成 False，这将导致您的服务器代码进入一个实际上不读取任何内容的紧密的不屈服循环。只需完全摆脱检查并让 ReceiveStream() 阻塞，直到有数据包可供读取。

另外，为什么您将服务器的 ListenQueue 设置为 15，而将 MaxConnections 设置为 0？ MaxConnections=0 将强制服务器立即关闭接受的每个客户端连接，因此 OnExecute 事件永远不会有机会被调用。

在客户端，不需要在每次循环迭代中销毁和重新创建 TMemoryStream，您应该重用该对象。

但更重要的是，您没有正确使用写缓冲，因此要么修复它，要么摆脱它。我会选择后者，因为您要发送大量小数据包，所以让 TCP 的默认合并为您处理缓冲。

并且 TIdIOHandler.Write(TStream)/TIdIOHandler.ReadStream() 可以为您交换流大小，您无需手动执行此操作。

试试这个：

服务器

program Srv;

{$I Synopse.inc}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,{$ENDIF}{$ENDIF}
  Classes,SysUtils,CustApp,Generics.Collections,IdTCPServer,IdCustomTCPServer,IdContext,IdGlobal,Db,mORMot,mORMotSQLite3,IdSync,functions,SynCommons,SynSQLite3Static;

type

  { TMyApplication }
  TMyApplication = class(TCustomApplication)
  var
    IdTCPServer: TIdTCPServer;
  protected
    procedure DoRun; override;
    procedure ServerOnConnect(AContext: TIdContext);
    procedure ServerOnExecute(AContext: TIdContext);
    function ReceiveStream(AContext: TIdContext; Size: Integer; var AStream: TStream);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;

  type
    TLog = class(TIdNotify)
    protected
      FMsg: string;
      procedure DoNotify; override;
    public
      class procedure LogMsg(const AMsg: string);
    end;

{ TMyApplication }

procedure TLog.DoNotify;
begin
  WriteLn(FMsg);
end;

class procedure TLog.LogMsg(const AMsg: string);
begin
  with TLog.Create do
  try
    FMsg := AMsg;
    Notify;
  except
    Free;
    raise;
  end;
end;

function TMyApplication.ReceiveStream(AContext: TIdContext; AStream: TStream): Boolean; overload;
begin
  try
    AContext.Connection.IOHandler.ReadStream(AStream,-1,False);
    AStream.Position := 0;
    Result := True;
  except
    Result := False;
  end;
end;      

procedure TMyApplication.ServerOnExecute(AContext: TIdContext);
var
  AStream: TMemoryStream;
begin
  AStream := TMemoryStream.Create;
  try 
    if not ReceiveStream(AContext,AStream) then
    begin
      AContext.Connection.Disconnect;
      Exit;
    end;
    TLog.LogMsg('--: '+random(100000).ToString); //After executing Client this line is displayed 70 time and CPU load is from 40 % to 70%
    // .. here we use AStream to execute some stuff  
  finally
    AStream.Free;
  end;        
end;

procedure TMyApplication.ServerOnConnect(AContext: TIdContext);
begin
  TLog.LogMsg('connect');        
  AContext.Connection.IOHandler.LargeStream := False;
end;

procedure TMyApplication.DoRun;
begin
  IdTCPServer := TIdTCPServer.Create;
  IdTCPServer.ListenQueue := 15;
  IdTCPServer.MaxConnections := 1;
  IdTCPServer.TerminateWaitTime := 5000;
  with IdTCPServer.Bindings.Add do
  begin
    IP   := '0.0.0.0';
    Port := 80;
    IPVersion := Id_IPv4;
  end;
  IdTCPServer.OnConnect := ServerOnConnect;
  IdTCPServer.OnDisconnect := ServerOnDiconnect;
  IdTCPServer.OnExecute := ServerOnExecute;
  IdTCPServer.Active := True;

  while True do
  begin
    Classes.CheckSynchronize();
    Sleep(10);
  end;

  ReadLn;
  Terminate;
end;

constructor TMyApplication.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException := True;
end;

destructor TMyApplication.Destroy;
begin
  IdTCPServer.Free;
  inherited Destroy;
end;

var
  Application: TMyApplication;
begin
  Application := TMyApplication.Create(nil);
  Application.Title := 'My Application';
  Application.Run;
  Application.Free;
end.

客户

function TForm1.SendStream(AClient: TIdTCPClient; AStream: TStream): Boolean; overload;
begin
  try
    AClient.IOHandler.LargeStream := False; // <-- or,set this 1 time after TIdTCPClient.Connect() exits...
    AClient.IOHandler.Write(AStream,True);
    Result := True;
  except
    Result := False;
  end;
end;   
    
procedure TForm1.Button1Click(Sender: TObject);
var 
  Packet: TPacket;
  AStream: TMemoryStream;
  i: Integer;
begin
  AStream := TMemoryStream.Create;
  try
    AStream.Size := SizeOf(TPacket);
    for i := 0 to 1000 do 
    begin
      Application.ProcessMessages;
      with Packet do
      begin
        MX := random(10000);
        MY := random(10000);
      end;
      AStream.Position := 0;
      AStream.Write(Packet,SizeOf(TPacket));
      SendStream(IdTCPClientCmd,AStream);
    end;
  finally
    AStream.Free;
  end;
end;

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。

相关推荐

导入项目后报错问题
依赖报错 idea导入项目后依赖报错，解决方案：https://blog.csdn.net/weixin_42420249/article/details/81191861 依赖版本报错：更换其他版本 无法下载依赖可参考：https://blog.csdn.net/weixin_42628809/a
idea不能识别yaml文件
使用mybatis plus常见错误
错误1：代码生成器依赖和mybatis依赖冲突 启动项目时报错如下 2021-12-03 13:33:33.927 ERROR 7228 [ main] o.s.b.d.LoggingFailureAnalysisReporter : *************************** APPL
gradle常见问题与错误
错误1：gradle项目控制台输出为乱码 # 解决方案：https://blog.csdn.net/weixin_43501566/article/details/112482302 # 在gradle-wrapper.properties 添加以下内容 org.gradle.jvmargs=-Df
Mybatis Plus传入参数0不起作用
错误还原：在查询的过程中，传入的workType为0时，该条件不起作用 &lt;select id=&quot;xxx&quot;&gt; SELECT di.id, di.name, di.work_type, di.updated... &lt;where&gt; &lt;if test=&qu
linux中make编译源码包失败
报错如下，gcc版本太低 ^ server.c:5346:31: 错误：‘struct redisServer’没有名为‘server_cpulist’的成员 redisSetCpuAffinity(server.server_cpulist); ^ server.c: 在函数‘hasActiveC
微服务启动错误：Command line is too long. Shorten command line for
解决方案1 1、改项目中.idea/workspace.xml配置文件，增加dynamic.classpath参数 2、搜索PropertiesComponent，添加如下 &lt;property name=&quot;dynamic.classpath&quot; value=&quot;tru
vue常见错误
删除根组件app.vue中的默认代码后报错：Module Error (from ./node_modules/eslint-loader/index.js): 解决方案：关闭ESlint代码检测，在项目根目录创建vue.config.js，在文件中添加 module.exports = { lin
spark常见错误
查看spark默认的python版本 [root@master day27]# pyspark /home/software/spark-2.3.4-bin-hadoop2.7/conf/spark-env.sh: line 2: /usr/local/hadoop/bin/hadoop: No s
matplotlib报错：AttributeError: module 'backend_interagg' has no attribute 'FigureCanvas'. Did you mean: 'FigureCanvasAgg'?
使用本地python环境可以成功执行 import pandas as pd import matplotlib.pyplot as plt # 设置字体 plt.rcParams[&#39;font.sans-serif&#39;] = [&#39;SimHei&#39;] # 能正确显示负号 p
gitlab登录失败，报错：This challenge page was accidentally cached by an intermediary and is no longer available.
设置时间 控制面板
后端开发常见错误
错误1：Request method ‘DELETE‘ not supported 错误还原：controller层有一个接口，访问该接口时报错：Request method ‘DELETE‘ not supported 错误原因：没有接收到前端传入的参数，修改为如下 参考 错误2：cannot r
docker常见错误
错误1：启动docker镜像时报错：Error response from daemon: driver failed programming external connectivity on endpoint quirky_allen 解决方法：重启docker -&gt; systemctl r
idea常见错误
错误1：private field ‘xxx‘ is never assigned 按Altʾnter快捷键，选择第2项 参考：https://blog.csdn.net/shi_hong_fei_hei/article/details/88814070 错误2：启动时报错，不能找到主启动类 #
pip安装依赖失败
报错如下，通过源不能下载，最后警告pip需升级版本 Requirement already satisfied: pip in c:\users\ychen\appdata\local\programs\python\python310\lib\site-packages (22.0.4) Coll
maven常见错误
错误1：maven打包报错 错误还原：使用maven打包项目时报错如下 [ERROR] Failed to execute goal org.apache.maven.plugins:maven-resources-plugin:3.2.0:resources (default-resources)
cloud项目中常见错误
错误1：服务调用时报错 服务消费者模块assess通过openFeign调用服务提供者模块hires 如下为服务提供者模块hires的控制层接口 @RestController @RequestMapping(&quot;/hires&quot;) public class FeignControl
springboot常见错误
错误1：运行项目后报如下错误 解决方案 报错2：Failed to execute goal org.apache.maven.plugins:maven-compiler-plugin:3.8.1:compile (default-compile) on project sb 解决方案：在pom.
springmvc拦截器中使用redisTemplate报空指针异常
参考 错误原因 过滤器或拦截器在生效时，redisTemplate还没有注入 解决方案：在注入容器时就生效 @Component //项目运行时就注入Spring容器 public class RedisBean { @Resource private RedisTemplate&lt;String
vite报错：npm ERR! command C:WINDOWSsystem32cmd.exe /d /s /c C:UsersychenAppDataLocalTempnpx-dde1c848.cmd
使用vite构建项目报错 C:\Users\ychen\work&gt;npm init @vitejs/app @vitejs/create-app is deprecated, use npm init vite instead C:\Users\ychen\AppData\Local\npm-
pythonJavaScriptjavaHTMLPHPreactjsC#AndroidCSSNode.jssqlrpython-3.xMysqLjQueryc++pandasFlutterangularIOSdjangolinuxswifttypescript路由器JSON路由器设置无线路由器h3c华三华三路由器设置华三路由器电脑软件教程arraysdocker软件图文教程Cvue.jslaravelspring-boot