使用 TMemoryStream 通过 IdTCPServer 和 TIdThreadSafeObjectList 发送数据时出现问题

Question

我缺少一些尝试实现发送 TMemoryStream 数据的方法，因为当我尝试将它们发送到 TMyContext.SendQueue() 中的客户端时，流是空的。

这是我的简化代码：

TMyContext = class(TIdServerContext)
  private
    Context_ID: string;
    Queue: TIdThreadSafeObjectList;
    QueuePending: Boolean;
  public
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;
    procedure AddToQueue(const ms: TMemoryStream);
    procedure SendQueue;
  end;
...
...

constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited;
  Queue := TIdThreadSafeObjectList.Create;
end;

destructor TMyContext.Destroy;
begin
  Queue.Free;
  inherited;
end;

procedure TMyContext.AddToQueue(const ms: TMemoryStream);
var
  List: TList;
begin
  List := Queue.LockList;
  try
    list.Add(ms);
    QueuePending := True;
  finally
    Queue.UnlockList;
  end;
end;

procedure TMyContext.SendQueue;
var
  list: TList;
  i: Integer;
begin
  if not QueuePending then
    Exit;

  list := Queue.LockList;
  try
    if list.Count = 0 then
    begin
      QueuePending := False;
      Exit;
    end;

    for i := 0 to List.Count-1 do
      Connection.IOHandler.Write( TMemoryStream(List[i]), 0, True); // here List[i] size is 0
      // does the TMemoryStream object in OnExecute() still exist?

    list.Clear;
    QueuePending := False;
  finally
    Queue.UnlockList;
  end;
end;
...
...
procedure TServer.IdTCPServerConnect(AContext: TIdContext);
var
  LContext: TMyContext;
  ms: TMemorySTream;
begin
  LContext := TMyContext(AContext);

  ms := TMemoryStream.Create;
  try
    ...
    ...
    AContext.Connection.IOHandler.ReadStream(msgFromClient, size);
    msgFromClient.Position:= 0;
    ...

    // get some values from stream
    ...
    LContext.Context_ID  := Get_ID(ms);

  finally
    ms.Free;
  end;
end;

procedure TServer.IdTCPServerExecute(AContext: TIdContext);
var
  ms: TMemoryStream;
  LContext,Ctx_Peer2: TMyContext;
  List: TList;
  I: integer;
begin
  LContext := TMyContext(AContext);

  //send pending messages from the server
  LContext.SendQueue;


  //check for a message received from the client
  if AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    AContext.Connection.IOHandler.CheckForDataOnSource(100);
    AContext.Connection.IOHandler.CheckForDisconnect;
    if AContext.Connection.IOHandler.InputBufferIsEmpty then Exit;
  end;

  size:=AContext.Connection.IOHandler.ReadLongInt;
  try
    try
      ms := TMemoryStream.Create;
      AContext.Connection.IOHandler.ReadStream(msgStream, size);
    except
      Exit;
    end;

    // do some stuuf with ms stream
    ...
    ...

    // put new data into ms and send to the calling context queue
    ms.clear:= 0;
    ...
    ...
    ms.position := 0;
    LContext.AddToQueue(ms);

    // put new data into ms and send to another peer
    // do I have to use a different TMemoryStream variable than ms here?
    ms.clear:= 0;
    ...
    ...
    ms.position := 0;
    List := IdTCPServer.Contexts.LockList;
    try

      for I := 0 to List.Count-1 do
      begin
        if (TMyContext(List[I].Context_ID = context_id_i_want_to_send) then
        begin
          Ctx_Peer2 := TMyContext(List[I]);
          Break;
        end;
      end;
      Ctx_Peer2.AddToQueue(ms);
    finally
      IdTCPServer.Contexts.UnlockList;
    end;

  finally
    ms.Free;
  end;
end;

procedure TServer.IdTCPServerDisconnect(AContext: TIdContext);
var
  Ctx: TMyContext;
begin
  Ctx := TMyContext(AContext);
  Ctx.Context_ID = '';
  Ctx.Queue.Clear;
end;

仍然在SendQueue()中，我不认为每个流都被发送到正确的客户端，因为在我看来，这个连接丢失了；我必须滚动浏览所有可用的上下文吗？

Answer 1

你有未定义的行为。您将在发送之前释放

TMemoryStream

。一旦将其添加到队列中，请勿释放它，直到将其从队列中删除。

TIdThreadSafeObjectList

有一个

OwnsObjects

属性，您可以将其设置为 True 以获取所有权并为您释放对象。