Delphi - Indy stream validation

I'm trying to take a live screen shots from client.

The TImage imgScreen in the server side raises this error.

EJPEG with message 'JPEG error #53'

I have google it and found out this error come due to Insufficient memory - image corrupted.

How i can validate the stream before save/display it?

What is the reason to make the server receive a corrupted stream?

is it in the JpegStream.Size and IOHandler.ReadInt64 methods.

Here is the code.

Client Side

 if List[0] = 'RecordScreen' then
  begin
    pic := TBitmap.Create;
    JpegStream := TMemoryStream.Create;
    ScreenShot(0,0,pic);

    BMPtoJPGStream(pic, JpegStream);
    pic.FreeImage;
    FreeAndNil(pic);

    AConn.Client.IOHandler.Write(JpegStream.Size);
    AConn.Client.IOHandler.Write(JpegStream);
    FreeAndNil(JpegStream);
  end;

Server Side

procedure ScreenRecord(const Item: TListItem);
var
  Ctx: TIdContext;
  List: TIdContextList;
  Dir,PicName:string;
  PicStream : TFileStream;
  Size : Int64;
begin
  if (Item = nil) then Exit;
  Ctx := TIdContext(Item.Data);
  if (Ctx = nil) then Exit;
  Dir := IncludeTrailingBackslash(TMyContext(Ctx).ClinetDir+ScreenshotsDir);
  if not DirectoryExists(Dir) then
  CreateDir(Dir);

  PicName := Dir+'Screen-'+DateTimeToFilename+'.JPG';

  PicStream := TFileStream.Create(PicName,fmCreate);
  try
    List := MainForm.idtcpsrvrMain.Contexts.LockList;
    try
      if List.IndexOf(Ctx) <> -1 then
      Begin
        TMyContext(Ctx).Queue.Add('RecordScreen');
        Size := TMyContext(Ctx).Connection.IOHandler.ReadInt64();
        TMyContext(Ctx).Connection.IOHandler.ReadStream(PicStream,Size,False);
        FreeAndNil(PicStream);
        TMyContext(Ctx).Connection.IOHandler.WriteLn('RecordScreenDone');
        fScreenRecord.imgScreen.Picture.LoadFromFile(PicName);
        end;
    finally
      MainForm.idtcpsrvrMain.Contexts.UnlockList;
    end;
  except
  end;
end;

procedure TScreenRecord.Execute;
begin
  FreeOnTerminate := True;
  IsThreadWorking := True;
  while NOT Terminated do
  Begin
    ScreenRecord(MainForm.lvMain.Selected);
    Sleep(50);
    if KillThread then
    Terminate;
  End;
end;

Solution

I cannot really say for sure why you are getting a JPG error. But there are some logic issues in the code you have shown.

Although not really a problem, there is also no need to call TIdIOHandler.Write(Int64)and TIdIOHandler.Write(TStream) separately. The latter can send the stream size for you. Simply set its AWriteByteCount parameter to True, and make sure to set the TIdIOHandler.LargeStream property to True so it will send the byte count as an Int64:

AConn.Client.IOHandler.LargeStream := True;
AConn.Client.IOHandler.Write(JpegStream, 0, True);

Likewise, you do not need to call TIdIOHandler.ReadInt64() and TIdIOHandler.ReadStream() separately, either. The latter can read the stream size for you. Simply set its AByteCount parameter to -1 and its AReadUntilDisconnect parameter to False (those are the default values anyway), and set TIdIOHandler.LargeStream to True so it reads the stream size as an Int64:

TMyContext(Ctx).Connection.IOHandler.LargeStream := True;
TMyContext(Ctx).Connection.IOHandler.ReadStream(PicStream, -1, False);

That will put the burden on Indy to send and receive the stream consistently, rather than you trying to do it manually.

Now, with that said, the more important problem with your code is that your ScreenRecord() function is clearly running in a worker thread, however it is NOT actually thread-safe. Specifically, you are not synchronizing with the main UI thread when accessing lvMain.Selected or calling Picture.LoadFromFile(). That, in of itself, could be causing the JPG error. VCL/FMX UI controls cannot safely be accessed outside of the main UI thread, you MUST synchronize access to them.

In fact, your stream reading logic really belongs in the TIdTCPServer.OnExecute event instead. In which case, you can eliminate the TScreenRecord thread completely (since TIdTCPServer is already multi-threaded). When the user selects a new list item, set a flag in the corresponding TMyContext (and clear the flag in the previously selected item, if any). Have the OnExecute event handler request/receive a stream whenever that flag is set on a given connection.

Try something more like this:

Client Side

if List[0] = 'RecordScreen' then
begin
  JpegStream := TMemoryStream.Create;
  try
    pic := TBitmap.Create;
    try
      ScreenShot(0,0,pic);
      BMPtoJPGStream(pic, JpegStream);
    finally
      pic.Free;
    end;
    AConn.Client.IOHandler.LargeStream := True;
    AConn.Client.IOHandler.Write(JpegStream, 0, True);
  finally
    JpegStream.Free;
  end;
end;

Server Side

type
  TMyContext = class(TIdServerContext)
  public
    //...
    RecordScreen: Boolean;
  end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  idtcpsrvrMain.ContextClass := TMyContext;
  //...
end;

var
  SelectedItem: TListItem = nil;

procedure TMainForm.lvMainChange(Sender: TObject; Item: TListItem; Change: TItemChange);
var
  List: TList;
  Ctx: TMyContext;
begin
  if Change <> ctState then
    Exit;

  List := idtcpsrvrMain.Contexts.LockList;
  try
    if (SelectedItem <> nil) and (not SelectedItem.Selected) then
    begin
      Ctx := TMyContext(SelectedItem.Data);
      if List.IndexOf(Ctx) <> -1 then
        Ctx.RecordScreen := False;
      SelectedItem := nil;
    end;
    if Item.Selected then
    begin
      SelectedItem := Item;
      Ctx := TMyContext(SelectedItem.Data);
      if List.IndexOf(Ctx) <> -1 then
        Ctx.RecordScreen := True;
    end;
  finally
    idtcpsrvrMain.Contexts.UnlockList;
  end;
end;

procedure TMainForm.idtcpsrvrMainConnect(AContext: TIdContext);
begin
  //...
  TThread.Queue(nil,
    procedure
    var
      Item: TListItem;
    begin
      Item := lvMain.Items.Add;
      Item.Data := AContext;
      //...
    end
  );
end;

procedure TMainForm.idtcpsrvrMainDisconnect(AContext: TIdContext);
begin
  TThread.Queue(nil,
    procedure
    var
      Item: TListItem;
    begin
      Item := lvMain.FindData(0, AContext, True, False);
      if Item <> nil then Item.Delete;
    end
  );
end;

procedure TMainForm.idtcpsrvrMainExecute(AContext: TIdContext);
var
  Dir, PicName: string;
  PicStream: TMemoryStream;
  Ctx: TMyContext;
begin
  Ctx := TMyContext(AContext);
  Sleep(50);

  if not Ctx.RecordScreen then
    Exit;

  PicStream := TMemoryStream.Create;
  try
    AContext.Connection.IOHandler.WriteLn('RecordScreen');
    AContext.Connection.IOHandler.LargeStream := True;
    AContext.Connection.IOHandler.ReadStream(PicStream, -1, False);
    AContext.Connection.IOHandler.WriteLn('RecordScreenDone');

    if not Ctx.RecordScreen then
      Exit;

    try
      Dir := IncludeTrailingBackslash(Ctx.ClinetDir + ScreenshotsDir);
      ForceDirectories(Dir);
      PicName := Dir + 'Screen-' + DateTimeToFilename + '.JPG';
      PicStream.SaveToFile(PicName);
      TThread.Queue(nil,
        procedure
        begin
          fScreenRecord.imgScreen.Picture.LoadFromFile(PicName);
        end;
      );
    except
    end;
  finally
    PicStream.Free;
  end;
end;

Now, with that said, to better optimize your protocol, I would suggest sending the RecordScreen command only once when you are ready to begin receiving images (when the client is selected in the ListView) and send the RecordScreenDone command only once when you are ready to stop receiving images (when the client is unselected in the ListView). Have the client send a continuous stream of images when it receives ReccordScreen until it receives RecordScreenDone or the client is disconnected.

Something like this:

Client Side

if List[0] = 'RecordScreen' then
begin
  // Start a short timer...
end
else if List[0] = 'RecordScreenDone' then
begin
  // stop the timer...
end;

...

procedure TimerElapsed;
var
  JpegStream: TMemoryStream;
  pic: TBitmap;
begin
  JpegStream := TMemoryStream.Create;
  try
    pic := TBitmap.Create;
    try
      ScreenShot(0,0,pic);
      BMPtoJPGStream(pic, JpegStream);
    finally
      pic.Free;
    end;
    try
      AConn.Client.IOHandler.LargeStream := True;
      AConn.Client.IOHandler.Write(JpegStream, 0, True);
    except
      // stop the timer...
    end;
  finally
    JpegStream.Free;
  end;

Server Side

type
  TMyContext = class(TIdServerContext)
  public
    //...
    RecordScreen: Boolean;
    IsRecording: Boolean;
  end;

procedure TMainForm.idtcpsrvrMainExecute(AContext: TIdContext);
var
  Dir, PicName: string;
  PicStream: TMemoryStream;
  Ctx: TMyContext;
begin
  Ctx := TMyContext(AContext);
  Sleep(50);

  if not Ctx.RecordScreen then
  begin
    if Ctx.IsRecording then
    begin
      AContext.Connection.IOHandler.WriteLn('RecordScreenDone');
      Ctx.IsRecording := False;
    end;
    Exit;
  end;

  if not Ctx.IsRecording then
  begin
    AContext.Connection.IOHandler.WriteLn('RecordScreen');
    Ctx.IsRecording := True;
  end;

  PicStream := TMemoryStream.Create;
  try
    AContext.Connection.IOHandler.LargeStream := True;
    AContext.Connection.IOHandler.ReadStream(PicStream, -1, False);

    if not Ctx.RecordScreen then
    begin
      AContext.Connection.IOHandler.WriteLn('RecordScreenDone');
      Ctx.IsRecording := False;
      Exit;
    end;

    try
      Dir := IncludeTrailingBackslash(Ctx.ClinetDir + ScreenshotsDir);
      ForceDirectories(Dir);
      PicName := Dir + 'Screen-' + DateTimeToFilename + '.JPG';
      PicStream.SaveToFile(PicName);
      TThread.Queue(nil,
        procedure
        begin
          fScreenRecord.imgScreen.Picture.LoadFromFile(PicName);
        end;
      );
    except
    end;
  finally
    PicStream.Free;
  end;
end;