Серверу TmemoryStream не хватает памяти при получении потока - PullRequest
Новая
       16

Серверу TmemoryStream не хватает памяти при получении потока

0 голосов
/ 14 января 2019

Все, что я пытаюсь сделать, это отправить поток с помощью TSockets, но у меня ошибка «недостаточно памяти». Мне удалось отправить файлы, только не изображения. В событии 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;

1 Ответ

0 голосов
/ 15 января 2019

Вы не учитываете 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;
...