Multithreading DELPHI中使用Indy组件（idTCPServer/idTCPClient）的单服务器与多客户端实时监控系统

我在构建Indy服务器/客户端实时监控系统时遇到了一个重要问题。。。 我使用的是Delphi2010，Indy版本是10.5.5。。。。。。。。。 我的目的是，许多客户端PC连续（4~10fps）向服务器发送屏幕截图，服务器必须向一些监控PC发送这些屏幕截图帧。 换句话说

Many clients -----send streams--------> to Server
Some monitors <---receive streams----- from Server

许多客户端------向服务器发送流---------------->
某些监视器接收失败：'+IntToStr（recv_Stream.Size）+'byte'；
recv_Stream.Free；
出口
结束；
如果recv_Stream.Size<1024，则
开始
recv_Stream.Seek（0，从开始）；
ROutMsg:=AContext.Binding.PeerIP+'->已接收到captionString（'+
IntToStr（recv_Stream.Size）+字节）：“+StringFromStream（TStream（recv_Stream））+”；
recv_Stream.Free；
结束
其他的
开始
ROutMsg:=AContext.Binding.PeerIP+'->收到的屏幕截图：'+KBStr（recv_Stream.Size）+'KB'；
如果G_Sendable=False，则
开始
send_Stream:=TMemoryStream.Create；
发送_-Stream.Clear；
recv_Stream.Seek（0，从开始）；
send_Stream.Seek（0，从开始）；
send_Stream.CopyFrom（recv_Stream，recv_Stream.Size）；
G_Sendable:=真；
结束；
recv_Stream.Free；
结束；
结束；
Application.ProcessMessages；
WaitForSingleObject（句柄，1）；
结束；
{另一方面--idTCPServerSend将向监视器发送屏幕截图流}
过程TIndyServerForm.IdTCPServer_SendExecute（AContext:TIdContext）；
开始
如果G_Sendable那么
开始
send_Stream.Seek（0，从开始）；
如果（SendStream（AContext，TStream（send_Stream））=False），则
开始
SOutMsg:=AContext.Binding.PeerIP+'->发送失败->'+KBStr（send_Stream.Size）+'KB'；
免费发送；
G_Sendable:=假；
出口
结束；
SOutMsg:=AContext.Binding.PeerIP+'->发送成功->'+KBStr（send_Stream.Size）+'KB'；
免费发送；
G_Sendable:=假；
结束；
Application.ProcessMessages；
WaitForSingleObject（句柄，1）；
结束；

对于具有实时流交换的多客户端连接，我应该怎么做。。。 每台客户端PC每秒发送4~10次屏幕截图流。。。 这些流必须发送到相应的监视器

---

请给我一些建议……

在“监视器”端，线程中的TIdTCPClient可以侦听来自服务器的传入屏幕截图数据。我在这里发布了一篇关于Indy（源代码）服务器端推送消息技术的博客文章：

---

需要额外的服务器端代码将传入数据定向到监控客户端。实际上，您只需要在上下文中添加“标记”（可以是布尔标志），指示此连接是否正在发送或监视屏幕截图数据。如何将自定义属性分配给连接上下文并对其进行迭代已经在这里的其他问题中得到了回答。

您的代码甚至还没有接近线程安全，这就是您出现错误的原因。

IdTCPServer_Recv

中的每个客户端线程都将各自的屏幕快照接收到单个共享

Recv_流

变量，然后将该数据复制到单个共享

send_流

变量。然后，连接到

IdTCPServer\u Send

的所有客户端将同时读取和发送相同的

Send\u流。你把记忆踩得到处都是

您需要使用局部变量而不是共享变量来接收每个屏幕截图，并且需要为每个监视器客户端使用单独的
TStream
对象。不要使用共享的
TStream
进行发送，当然也不要使用全局布尔变量来让每个监视器客户端执行此操作。让
IdTCPServer\u RecvExecute（）
主动创建一个新的
TMemoryStream
对象，并将其传递给每个需要发送当前屏幕截图的监视器客户端

尝试类似以下内容：

uses
  ..., IdThreadSafe;

type
  TMonitorContext = class(TIdServerContext)
  public
    Screenshots: TIdThreadSafeObjectList;
    ScreenshotEvent: THandle;
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override;
    destructor Destroy; override;
  end;

  TScreenshotInfo = class
  public
    ClientIP: string;
    ClientPort: TIdPort;
    Data: TMemoryStream;
    constructor Create;
    destructor Destroy; override;
  end;

constructor TMonitorContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList);
begin
  inherited;
  Screenshots := TIdThreadSafeObjectList.Create;
  Screenshots.OwnsObjects := True;
  ScreenshotEvent := CreateEvent(null, True, False, nil);
end;

destructor TMonitorContext.Destroy;
begin
  Screenshots.Free;
  CloseHandle(ScreenshotEvent);
  inherited;
end;

constructor TScreenshotInfo.Create;
begin
  inherited;
  Data := TMemoryStream.Create;
end;

destructor TScreenshotInfo.Destroy;
begin
  Data.Free;
  inherited;
end;

{one side----idTCPServerRecv is to receive screenshot streams from clients}

procedure TIndyServerForm.IdTCPServer_RecvExecute(AContext: TIdContext);
var
  recv_stream: TMemoryStream;
  monitors, queue: TList;
  i: Integer;
  screenshot: TScreenshotInfo;
  monitor: TMonitorContext;
begin
  recv_stream := TMemoryStream.Create;
  try
    if not ReceiveStream(AContext, recv_stream) then
    begin
      ROutMsg := AContext.Binding.PeerIP + ' -> receiving failed: ' + IntToStr(recv_Stream.Size) + ' byte';
      Exit;
    end;
    if recv_Stream.Size < 1024 then
    begin
      recv_Stream.Position := 0;
      ROutMsg := AContext.Binding.PeerIP + ' -> captionString received(' + 
                IntToStr(recv_Stream.Size) + ' byte) : "' + StringFromStream(recv_Stream) + '"';
    end
    else
    begin
      ROutMsg := AContext.Binding.PeerIP + ' -> screenshot received: ' + KBStr(recv_Stream.Size) + ' KB';

      monitors := IdTCPServer_Send.Contexts.LockList;
      try
        // alternatively, only queue the screenshot to particular monitors
        // that are actually interested in this client...
        for i := 0 to monitors.Count-1 do
        begin
          monitor := TMonitorContext(monitors[i]);
          screenshot := TScreenshotInfo.Create;
          try
            recv_Stream.Position := 0;
            screenshot.Data.CopyFrom(recv_stream, 0);
            screenshot.Data.Position := 0;
            queue := monitor.Screenshots.LockList;
            try
              queue.Add(screenshot);
              SetEvent(monitor.ScreenshotEvent);
            finally
              monitor.Screenshots.UnlockList;
            end;
          except
            screenshot.Free;
          end;
        end;
      finally
        IdTCPServer_Send.Contexts.UnlockList;
      end;
    end;
  finally
    recv_stream.Free;
  end;
end;

{another side----idTCPServerSend is to send screenshot streams to monitors}

procedure TIndyServerForm.FormCreate(Sender: TObject);
begin
  IdTCPServer_Send.ContextClass := TMonitorContext;
end;

procedure TIndyServerForm.IdTCPServer_SendExecute(AContext: TIdContext);
var
  monitor: TMonitorContext;
  queue: TList;
  i: Integer;
  screenshot: TScreenshotInfo;
begin
  monitor := TMonitorContext(AContext);
  if WaitForSingleObject(monitor.ScreenshotEvent, 1000) <> WAIT_OBJECT_0 then Exit;
  screenshot := nil;
  try
    queue := monitor.Screenshots.LockList;
    try
      if queue.Count > 0 then
      begin
        screenshot := TScreenshotInfo(queue[0]);
        queue.Delete(0);
      end;
      if queue.Count = 0 then
        ResetEvent(monitor.ScreenshotEvent);
    finally
      monitor.Screenshots.UnlockList;
    end;
    if screenshot = nil then Exit;
    // you should send screenshot.ClientIP and screenshot.ClientPort to
    // this monitor so it knows which client the screenshot came from...
    if not SendStream(AContext, screenshot.Data) then
    begin
      SOutMsg := AContext.Binding.PeerIP + ' -> sending failed -> ' + KBStr(screenshot.Data.Size) + ' KB';
      Exit;
    end;
    SOutMsg := AContext.Binding.PeerIP + ' -> sending successful-> ' + KBStr(screenshot.Data.Size) + ' KB';
  finally
    screenshot.Free;
  end;
end;

使用
…，IdThreadSafe；
类型
TMonitorContext=class（TIdServerContext）
公众的
截图：TIdThreadSafeObjectList；
截屏事件：坦德尔；
构造函数创建（a连接：TIdTCPConnection；AYarn:tidshrean；AList:TThreadList=nil）；推翻
毁灭者毁灭；推翻
结束；
TScreenshotInfo=class
公众的
ClientIP：字符串；
客户端口：TIdPort；
数据：TMemoryStream；
构造函数创建；
毁灭者毁灭；推翻
结束；
构造函数TMonitorContext.Create（连接：TIdTCPConnection；AYarn:tidshrean；列表：TThreadList）；
开始
继承；
屏幕截图：=TIdThreadSafeObjectList.Create；
Screenshots.OwnsObjects:=True；
ScreenshotEvent:=CreateEvent（null、True、False、nil）；
结束；
析构函数TMonitorContext.Destroy；
开始
截图。免费；
CloseHandle（屏幕快照事件）；
继承；
结束；
构造函数TScreenshotInfo.Create；
开始
继承；
数据：=TMemoryStream.Create；
结束；
析构函数TScreenshotInfo.Destroy；
开始
数据。免费；
继承；
结束；
{一边----idTCPServerRecv接收来自客户端的屏幕截图流}
程序TIndyServerForm.IdTCPServer_RecvExecute（AContext:TIdContext）；
变量
recv_流：TMemoryStream；
监视器，队列：TList；
i：整数；
截图：TScreenshotInfo；
监视器：TMonitorContext；
开始
recv_stream:=TMemoryStream.Create；
尝试
如果没有接收流（AContext，recv_stream），则
开始
ROutMsg:=AContext.Binding.PeerIP+'->接收失败：'+IntToStr（recv_Stream.Size）+'byte'；
出口
结束；
如果recv_Stream.Size<1024，则
开始
记录流位置：=0；
ROutMsg:=AContext.Binding.PeerIP+'->接收到字幕字符串（'+
IntToStr（recv_Stream.Size）+'字节）：“'+StringFromStream（recv_Stream）+'”；
结束
其他的
开始
ROutMsg:=AContext.Binding.PeerIP+'->收到的屏幕截图：'+KBStr（recv_Str
uses
  ..., IdThreadSafe;

type
  TMonitorContext = class(TIdServerContext)
  public
    Screenshots: TIdThreadSafeObjectList;
    ScreenshotEvent: THandle;
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override;
    destructor Destroy; override;
  end;

  TScreenshotInfo = class
  public
    ClientIP: string;
    ClientPort: TIdPort;
    Data: TMemoryStream;
    constructor Create;
    destructor Destroy; override;
  end;

constructor TMonitorContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList);
begin
  inherited;
  Screenshots := TIdThreadSafeObjectList.Create;
  Screenshots.OwnsObjects := True;
  ScreenshotEvent := CreateEvent(null, True, False, nil);
end;

destructor TMonitorContext.Destroy;
begin
  Screenshots.Free;
  CloseHandle(ScreenshotEvent);
  inherited;
end;

constructor TScreenshotInfo.Create;
begin
  inherited;
  Data := TMemoryStream.Create;
end;

destructor TScreenshotInfo.Destroy;
begin
  Data.Free;
  inherited;
end;

{one side----idTCPServerRecv is to receive screenshot streams from clients}

procedure TIndyServerForm.IdTCPServer_RecvExecute(AContext: TIdContext);
var
  recv_stream: TMemoryStream;
  monitors, queue: TList;
  i: Integer;
  screenshot: TScreenshotInfo;
  monitor: TMonitorContext;
begin
  recv_stream := TMemoryStream.Create;
  try
    if not ReceiveStream(AContext, recv_stream) then
    begin
      ROutMsg := AContext.Binding.PeerIP + ' -> receiving failed: ' + IntToStr(recv_Stream.Size) + ' byte';
      Exit;
    end;
    if recv_Stream.Size < 1024 then
    begin
      recv_Stream.Position := 0;
      ROutMsg := AContext.Binding.PeerIP + ' -> captionString received(' + 
                IntToStr(recv_Stream.Size) + ' byte) : "' + StringFromStream(recv_Stream) + '"';
    end
    else
    begin
      ROutMsg := AContext.Binding.PeerIP + ' -> screenshot received: ' + KBStr(recv_Stream.Size) + ' KB';

      monitors := IdTCPServer_Send.Contexts.LockList;
      try
        // alternatively, only queue the screenshot to particular monitors
        // that are actually interested in this client...
        for i := 0 to monitors.Count-1 do
        begin
          monitor := TMonitorContext(monitors[i]);
          screenshot := TScreenshotInfo.Create;
          try
            recv_Stream.Position := 0;
            screenshot.Data.CopyFrom(recv_stream, 0);
            screenshot.Data.Position := 0;
            queue := monitor.Screenshots.LockList;
            try
              queue.Add(screenshot);
              SetEvent(monitor.ScreenshotEvent);
            finally
              monitor.Screenshots.UnlockList;
            end;
          except
            screenshot.Free;
          end;
        end;
      finally
        IdTCPServer_Send.Contexts.UnlockList;
      end;
    end;
  finally
    recv_stream.Free;
  end;
end;

{another side----idTCPServerSend is to send screenshot streams to monitors}

procedure TIndyServerForm.FormCreate(Sender: TObject);
begin
  IdTCPServer_Send.ContextClass := TMonitorContext;
end;

procedure TIndyServerForm.IdTCPServer_SendExecute(AContext: TIdContext);
var
  monitor: TMonitorContext;
  queue: TList;
  i: Integer;
  screenshot: TScreenshotInfo;
begin
  monitor := TMonitorContext(AContext);
  if WaitForSingleObject(monitor.ScreenshotEvent, 1000) <> WAIT_OBJECT_0 then Exit;
  screenshot := nil;
  try
    queue := monitor.Screenshots.LockList;
    try
      if queue.Count > 0 then
      begin
        screenshot := TScreenshotInfo(queue[0]);
        queue.Delete(0);
      end;
      if queue.Count = 0 then
        ResetEvent(monitor.ScreenshotEvent);
    finally
      monitor.Screenshots.UnlockList;
    end;
    if screenshot = nil then Exit;
    // you should send screenshot.ClientIP and screenshot.ClientPort to
    // this monitor so it knows which client the screenshot came from...
    if not SendStream(AContext, screenshot.Data) then
    begin
      SOutMsg := AContext.Binding.PeerIP + ' -> sending failed -> ' + KBStr(screenshot.Data.Size) + ' KB';
      Exit;
    end;
    SOutMsg := AContext.Binding.PeerIP + ' -> sending successful-> ' + KBStr(screenshot.Data.Size) + ' KB';
  finally
    screenshot.Free;
  end;
end;