TmemoryStream Server Out Of Memory On receiving stream

问题

All I'm trying to do is send a stream with TSockets, but I'm having an "out of memory" error. I managed to send files, just not images. In the server Form's OnCreate event, I'm creating the stream. For the client, in the Form's OnCreate I'm creating the stream, also a bmp.

I've tried to see if it's not sending, but it's sending something, only I can't tell what. On the server side, I've tested sending commands to the client, and I know they send, also I've tested with booleans, but still get a memory error.

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;

回答1:

You are not taking FSize into account when reading data from the client. You are reading as much as the client sends, and not stopping when the stream size has been reached. And you are not taking into account that it may (and likely will) take multiple OnRead events to receive the entire image, so you may end up freeing your stream prematurely.

Also, TCustomWinSocket.SendStream() is not very stable, especially if you are using the socket in non-blocking mode. You should instead use TCustomWinSocket.SendBuf() directly in a loop and handle any socket errors as needed.

Try something more like this:

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;

来源：https://stackoverflow.com/questions/54187321/tmemorystream-server-out-of-memory-on-receiving-stream