multithreading - 使用-DELPHI中的Indy组件(idTCPServer/idTCPClient)的单服务器与多客户端实时监视系统

Question

我在构建Indy Server/Clients实时监视系统时遇到了一个重要问题。
我正在使用DELPHI 2010，并且Indy版本是10.5.5 .........
我的目的是许多客户端PC连续向服务器发送屏幕截图(4〜10fps)，服务器必须将这些屏幕截图帧发送到某些监视PC。
换一种说法....

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

当然，如果只有一台客户端和一台带服务器的监视器，则效果很好...
但是，如果连接了另一个客户端或监视器，则服务器将引发异常“地址000000000 .....上的访问冲突”或“无效的指针操作”，并断开客户端或监视器的连接。

结果，客户端或监视器将与服务器断开连接。

我使用了idTCPClient组件，使用线程描述了客户端和监视器代码，用于发送和接收流。
我确定客户端和监控端的代码没有问题...
但是我认为服务器端绝对会有问题。

对于服务器端，我使用了两个TidTCPServer控件...
一种是从客户端PC接收流，另一种是发送流以监视PC。

服务器代码如下所示...

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

procedure TIndyServerForm.IdTCPServer_RecvExecute(AContext: TIdContext);
var
  Hb: TIdIOHandler;
  TempStr: TStrings;
begin

  Hb := AContext.Connection.IOHandler;
  if Not Hb.InputBufferIsEmpty then
  Begin
    Hb.CheckForDisconnect(True, True);
    AContext.Connection.IOHandler.CheckForDisconnect(True, True);

    recv_Stream := TMemoryStream.Create;
    recv_Stream.Clear;
    if (ReceiveStream(AContext, TStream(recv_Stream)) = False) then
    begin
      ROutMsg :=AContext.Binding.PeerIP+' -> receiving failed: ' + IntToStr(recv_Stream.Size)+'byte';
      recv_Stream.Free;
      Exit;
    end;
    if recv_Stream.Size < 1024 then
    begin
      recv_Stream.Seek(0, soFromBeginning);

      ROutMsg :=AContext.Binding.PeerIP+' -> captionString received('+
                IntToStr(recv_Stream.Size)+' byte) : "'+StringFromStream(TStream(recv_Stream))+'"';
      recv_Stream.Free;

    end
    else
    begin
      ROutMsg :=AContext.Binding.PeerIP+' -> screenshot received: ' + KBStr(recv_Stream.Size)+' KB';
      if G_Sendable = False then
      begin
        send_Stream:=TMemoryStream.Create;
        send_Stream.Clear;
        recv_Stream.Seek(0, soFromBeginning);
        send_Stream.Seek(0, soFromBeginning);
        send_Stream.CopyFrom(recv_Stream, recv_Stream.Size);
        G_Sendable :=True;
      end;
      recv_Stream.Free;

    end;
  end;
  Application.ProcessMessages;
  WaitForSingleObject(Handle, 1);
end;


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

procedure TIndyServerForm.IdTCPServer_SendExecute(AContext: TIdContext);
begin
    if G_Sendable then
    begin
      send_Stream.Seek(0,soFromBeginning);
      if (SendStream(AContext, TStream(send_Stream)) = False) then
      begin
        SOutMsg :=AContext.Binding.PeerIP+' -> sending failed -> ' + KBStr(send_Stream.Size)+' KB';
        send_Stream.Free;
        G_Sendable :=False;
        Exit;
      end;
      SOutMsg :=AContext.Binding.PeerIP+' -> sending successful-> ' + KBStr(send_Stream.Size)+' KB';
      send_Stream.Free;
      G_Sendable :=False;
    end;
    Application.ProcessMessages;
    WaitForSingleObject(Handle, 1);


end;

对于实时交换流的多客户端连接，我该怎么办...
每台客户端PC每秒发送屏幕截图流4〜10次...
这些流必须发送到相应的监视器
请给我建议。

Answer 1

您的代码甚至都不是线程安全的，这就是为什么您会出错。 IdTCPServer_Recv中的每个客户端线程都将其各自的快照接收到单个共享的recv_Stream变量，然后将该数据复制到单个共享的send_Stream变量。然后，所有连接到IdTCPServer_Send的客户端都将同时读取并发送相同的send_Stream。您到处都在践踏内存。

您需要使用局部变量而不是共享变量来接收每个屏幕快照，并且需要为每个监视器客户端使用单独的TStream对象。不要使用共享的TStream进行发送，当然也不要使用全局的boolean变量来让每个监视器客户端使用它。让IdTCPServer_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;