TmemoryStream 服务器在接收流时内存不足

Question

我想做的就是使用 TSockets 发送一个流，但是我遇到了 "out of memory" 错误。我设法发送文件，而不是图像。在服务器表单的 OnCreate 事件中，我正在创建流。对于客户端，在表单的 OnCreate 我正在创建流，也是一个 bmp。

我试过看它是不是不发送，但是它发送了一些东西，只是我不知道是什么。在服务器端，我测试了向客户端发送命令，我知道它们发送了，我也测试了布尔值，但仍然出现内存错误。

procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  BytesReceived: Longint;
  CopyBuffer: Pointer;
  ChunkSize: Integer;
  TempSize: Integer;
  FSize: Integer;
  writing: Boolean;
  bmp: tbitmap;
const
  MaxChunkSize: Longint = 8192;
begin
  If FSize = 0 then
  begin
    If Socket.ReceiveLength > SizeOf(TempSize) then
    begin
      Socket.ReceiveBuf(TempSize, SizeOf(TempSize));
      stream.SetSize(TempSize);
      FSize := TempSize;
    End;
  End;
  If (FSize > 0) and (writing) then            //receiving the image
  begin            
    GetMem(CopyBuffer, MaxChunkSize);
    writing := true;
    While Socket.ReceiveLength > 0 do
    Begin
      ChunkSize := Socket.ReceiveLength;
      If ChunkSize > MaxChunkSize then
        ChunkSize := MaxChunkSize;
      BytesReceived := Socket.ReceiveBuf(CopyBuffer^, ChunkSize);
      stream.Write(CopyBuffer^, BytesReceived);
      Dec(FSize, BytesReceived);
    End;
    If FSize = 0 then
    begin
      bmp.LoadFromStream(stream);
      self.Image1.Picture.Bitmap.LoadFromStream(stream);
      stream.SetSize(0);
      FSize := 0;
    End;                             
    FreeMem(CopyBuffer, MaxChunkSize);
    writing := false;
    stream.Free;
    exit;
  End;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  size: Integer;
  Data: string;
begin
  try
    CaptureImage(bmp); //i have a procedure for this & know it works
    bmp.SaveToStream(stream);
    size := stream.size;         //sending the tbitmap image
    stream.Position := 0;
    Socket.SendBuf(size, sizeof(size));
    Socket.SendStream(stream);
  except
    stream.Free;
  end;

Answer 1

您在从客户端读取数据时没有考虑 FSize。您正在阅读客户端发送的内容，并且在达到流大小时不会停止。而且您没有考虑到它可能（并且很可能会）需要多个 OnRead 事件来接收整个图像，因此您最终可能会过早地释放您的 stream。

此外，TCustomWinSocket.SendStream() 不是很稳定，尤其是在非阻塞模式下使用套接字时。您应该直接在循环中使用 TCustomWinSocket.SendBuf() 并根据需要处理任何套接字错误。

试试像这样的东西：

uses
  ..., System.Math;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Socket.Data := nil;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  if Socket.Data <> nil then
    TMemoryStream(Socket.Data).Free;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  Stream: TMemoryStream;
  BytesReceived: Integer;
  StreamSize, TempSize: Int32;
  BytesRemaining: Int64;
  P: PByte;
  ChunkSize: Integer;
  bmp: TBitmap;
const
  MaxChunkSize: Int64 = 8192;
begin
  Stream := TMemoryStream(Socket.Data);

  // receiving the image size
  if Stream = nil then
  begin
    if Socket.ReceiveLength < SizeOf(TempSize) then Exit;
    BytesReceived := Socket.ReceiveBuf(TempSize, SizeOf(TempSize));
    if BytesReceived <= 0 then Exit; 
    StreamSize := ntohl(TempSize);
    Stream := TMemoryStream.Create;
    Socket.Data := Stream;
    Stream.Size := StreamSize;
    BytesRemaining := StreamSize;
  end else
    BytesRemaining := Stream.Size - Stream.Position;

  // receiving the image
  if BytesRemaining > 0 then
  begin
    P := PByte(Stream.Memory);
    if Stream.Position > 0 then
      Inc(P, Stream.Position);
    repeat
      ChunkSize := Integer(Math.Min(BytesRemaining, MaxChunkSize));
      BytesReceived := Socket.ReceiveBuf(P^, ChunkSize);
      if BytesReceived <= 0 then Exit;
      Inc(P, BytesReceived);
      Dec(BytesRemaining, BytesReceived);
      Stream.Seek(soCurrent, BytesReceived);
    until BytesRemaining = 0;
  end;

  // loading the image
  try
    bmp := TBitmap.Create;
    try
      Stream.Position := 0;
      bmp.LoadFromStream(Stream);
      Image1.Picture.Bitmap.Assign(bmp);
    finally
      bmp.Free;
    end;
  finally
    Socket.Data := nil;
    Stream.Free;
  end;
end;

uses
  ..., System.Math, Winapi.WinSock;

function SendRaw(Sckt: TSocket; const Data; Size: Integer);
var
  P: PByte;
  BytesSent: Integer;
begin
  Result := 0;
  P := PByte(@Data);
  while Size > 0 do
  begin
    BytesSent := send(Sckt, P^, Size, 0);
    if BytesSent = -1 then Exit;
    Inc(P, BytesSent);
    Dec(Size, BytesSent);
    Inc(Result, BytesSent);
  end;
end;

procedure WriteToSocket(Socket: TCustomWinSocket; const Data; Size: Integer);
var
  Stream: TMemoryStream;
  P: PByte;
  BytesSent: Integer;
begin
  if Size <= 0 then Exit;

  Stream := TMemoryStream(Socket.Data);
  P := PByte(@Data);

  if not ((Stream <> nil) and (Stream.Size > 0)) then
  begin
    BytesSent := SendRaw(Socket.SocketHandle, P^, Size);
    if BytesSent > 0 then
    begin
      Dec(Size, BytesSent);
      if Size = 0 then Exit;
      Inc(P, BytesSent);
    end;
  end;

  if Stream = nil then
  begin
    Stream := TMemoryStream.Create;
    Socket.Data := Stream;
  end else
    Stream.Seek(soEnd, 0);

  Stream.WriteBuffer(P^, Size);
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
  Socket.Data := nil;
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  if Socket.Data <> nil then
    TMemoryStream(Socket.Data).Free;
end;

procedure TForm1.ClientSocket1Write(Sender: TObject; Socket: TCustomWinSocket);
var
  Stream: TMemoryStream;
  BytesRemaining: Int64;
  ChunkSize: Integer;
  P: PByte;
begin
  Stream := TMemoryStream(Socket.Data);
  if Stream = nil then Exit;

  BytesRemaining := Stream.Size;
  if BytesRemaining = 0 then Exit;

  P := PByte(Stream.Memory);
  repeat
    ChunkSize := Integer(Math.Min(BytesRemaining, MaxInt));
    BytesSent := SendRaw(Socket.SocketHandle, P^, ChunkSize);
    if BytesSent > 0 then
    begin
      Inc(P, BytesSent);
      Dec(BytesRemaining, BytesSent);
    end;
  until (BytesSent < ChunkSize) or (BytesRemaining = 0);

  if BytesRemaining = 0 then
    Stream.Clear
  else if P > Stream.Memory then
  begin
    MoveMemory(Stream.Memory, P, BytesRemaining);
    Stream.Size := BytesRemaining;
  end;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  Stream: TMemoryStream;
  bmp: TBitmap;
  StreamSize, TempSize: Int32;
begin
  ...
  Stream := TMemoryStream.Create;
  try
    // saving the bitmap image
    bmp := TBitmap.Create;
    try
      CaptureImage(bmp);
      bmp.SaveToStream(Stream);
    finally
      bmp.Free;
    end;

    // sending the TBitmap image
    StreamSize := Stream.Size;
    TempSize := htonl(StreamSize);
    WriteToSocket(Socket, TempSize, sizeof(TempSize));
    WriteToSocket(Socket, Stream.Memory^, StreamSize);
  finally
    Stream.Free;
  end;
end;

TmemoryStream 服务器在接收流时内存不足

TmemoryStream Server Out Of Memory On receiving stream

delphi

delphi-10.2-tokyo