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;                

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）