Delphi - Send stream using IdCmdTCPServer to a Client

Question

I'm trying to send a jpg image streaming taking from the android camera to client, using Indy 10, I got the example CameraComponent from Delphi, which get the image from the Camera and show in a TImage, what I'd like to do is send this stream to a client, using IdTCPClient.

I'm using IdCmdTCPServer to send the stream, ones the client require the data, but when I run the server application on my android (Galaxy S4 mini) the app runs too slow, the image showed from the Camera update to slow, I am able to connect to the server, but only one image is sent and then, the server app stop responding.

I think my problem is related to multi threading, however I can not figure out how to solve it. Here is my code.

unit uMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, FMX.Media,
  FMX.Platform, FMX.Objects, FMX.Layouts, FMX.Memo,FMX.Controls.Presentation,
  System.Generics.Collections,
  System.IOUtils, IdCmdTCPServer,
  IdCommandHandlers, IdContext, IdStack, IdBaseComponent, IdComponent,
  IdCustomTCPServer, IdTCPServer, FMX.ScrollBox, IdIOHandler, IdIOHandlerStream,
  IdCustomHTTPServer, IdHTTPServer, IdUDPBase, IdUDPServer, IdTCPConnection,
  IdSimpleServer;

type
  TCameraComponentForm = class(TForm)
    CameraComponent1: TCameraComponent;
    btnStartCamera: TButton;
    imgCameraView: TImage;
    btnFrontCamera: TSpeedButton;
    btnBackCamera: TSpeedButton;
    Memo1: TMemo;
    IdCmdTCPServer1: TIdCmdTCPServer;
    procedure btnStartCameraClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CameraComponent1SampleBufferReady(Sender: TObject;
      const ATime: TMediaTime);
    procedure btnFrontCameraClick(Sender: TObject);
    procedure btnBackCameraClick(Sender: TObject);
    procedure IdCmdTCPServer1Connect(AContext: TIdContext);
    procedure IdCmdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdCmdTCPServer1CommandHandlers0Command(ASender: TIdCommand);
  private
    { Private declarations }
    imag: TMemoryStream;
    Enable_Stream: Boolean;

    Camera_enable: Boolean;

    procedure GetImage;

    procedure SendStream;
  public
    { Public declarations }
    function AppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean;
  end;

var
  CameraComponentForm: TCameraComponentForm;

implementation

{$R *.fmx}
{$R *.NmXhdpiPh.fmx ANDROID}

procedure TCameraComponentForm.FormCreate(Sender: TObject);
var
  AppEventSvc: IFMXApplicationEventService;
begin
  Camera_enable:= False;
  // Stream to be sent
  imag:= TMemoryStream.Create;

  Enable_Stream:= False;
  // Start server
  IdCmdTCPServer1.Active:= True;

  { by default, we start with Front Camera and Flash Off }
  CameraComponent1.Kind := FMX.Media.TCameraKind.ckFrontCamera;
  if CameraComponent1.HasFlash then
    CameraComponent1.FlashMode := FMX.Media.TFlashMode.fmFlashOff;
  CameraComponent1.CaptureSettingPriority := TVideoCaptureSettingPriority.FrameRate;
  { Add platform service to see camera state. }
  if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, IInterface(AppEventSvc)) then
    AppEventSvc.SetApplicationEventHandler(AppEvent);
end;

procedure TCameraComponentForm.Timer1Timer(Sender: TObject);
begin
  imgCameraView.Repaint;
end;

{ Make sure the camera is released if you're going away.}

function TCameraComponentForm.AppEvent(AAppEvent: TApplicationEvent;
  AContext: TObject): Boolean;
begin
  case AAppEvent of
    TApplicationEvent.WillBecomeInactive:
      CameraComponent1.Active := False;
    TApplicationEvent.EnteredBackground:
      CameraComponent1.Active := False;
    TApplicationEvent.WillTerminate:
      CameraComponent1.Active := False;
  end;
end;

procedure TCameraComponentForm.btnBackCameraClick(Sender: TObject);
begin
  { select Back Camera }
  CameraComponent1.Active := False;
  CameraComponent1.Kind := FMX.Media.TCameraKind.BackCamera;
  CameraComponent1.Active := True;
end;

procedure TCameraComponentForm.btnFrontCameraClick(Sender: TObject);
begin
  { select Front Camera }
  CameraComponent1.Active := False;
  CameraComponent1.Kind := FMX.Media.TCameraKind.FrontCamera;
  CameraComponent1.Active := True;
end;

procedure TCameraComponentForm.btnStartCameraClick(Sender: TObject);
begin
  if Camera_enable = False then
  begin
    Camera_enable:= True;
    { turn on the Camera }
    CameraComponent1.Active := True;
  end
  else
  begin
    Camera_enable:= False;
    { turn off the Camera }
    CameraComponent1.Active := False;
  end;
end;

procedure TCameraComponentForm.CameraComponent1SampleBufferReady(
  Sender: TObject; const ATime: TMediaTime);
begin
  // Update the TImage
  TThread.Synchronize(TThread.CurrentThread, GetImage);

  // Save the bitmap to stream and send to client
  imgCameraView.Bitmap.SaveToStream(imag);
  if Enable_Stream then
     SendStream;
  //imgCameraView.Width := imgCameraView.Bitmap.Width;
  //imgCameraView.Height := imgCameraView.Bitmap.Height;
end;

procedure TCameraComponentForm.GetImage;
begin
  CameraComponent1.SampleBufferToBitmap(imgCameraView.Bitmap, True);
end;

procedure TCameraComponentForm.IdCmdTCPServer1CommandHandlers0Command(
  ASender: TIdCommand);
begin
  Memo1.Lines.Add('Send Stream');
  Enable_Stream:= True;
end;

procedure TCameraComponentForm.IdCmdTCPServer1Connect(AContext: TIdContext);
begin
  Memo1.Lines.Add('Connection being made - '+ AContext.Connection.Socket.Binding.PeerIP);
end;

procedure TCameraComponentForm.IdCmdTCPServer1Disconnect(AContext: TIdContext);
begin
  Memo1.Lines.Add('Disconnection being made - '+ AContext.Connection.Socket.Binding.PeerIP);
end;

procedure TCameraComponentForm.SendStream;
var
  index: integer;
begin
  // Write to the client in a thread safe way
  with IdCmdTCPServer1.Contexts.LockList do
  try
    for index := 0 to Count - 1 do
    begin
      TIdContext( Items[index] ).Connection.IOHandler.WriteLn('Stream');
      TIdContext( Items[index] ).Connection.IOHandler.Write(imag,0,True);
    end;
  finally
     IdCmdTCPServer1.Contexts.UnlockList;
  end;
end;

end.

I think the threads from the CameraComponent and Server are not synchronized, but I no idea how to solve it and speed up the app.

Any Help is appreciated.

Answer 1

TIdCmdTCPServer is a multithreaded component. The OnConnect, OnDisconnect and OnCommand events are triggered in the context of a worker thread that is created for a connected client. Your handlers for those events are not using thread-safe code, and you are doing your socket I/O in the context of the main UI thread instead of the client worker thread.

However, a TIdCmdTCPServer client worker thread is typically blocked while the client is not sending commands, and it does not natively allow you to inject your own I/O code during that idle time. So you will have to get a little creative to let client threads check the TImage for new images and send them without blocking the main UI thread.

Try something like this:

unit uMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, FMX.Media,
  FMX.Platform, FMX.Objects, FMX.Layouts, FMX.Memo, FMX.ScrollBox, FMX.Controls.Presentation,
  System.Generics.Collections,
  System.IOUtils, IdGlobal, IdCmdTCPServer,
  IdCommandHandlers, IdContext, IdStack, IdBaseComponent, IdComponent,
  IdCustomTCPServer, IdTCPServer, IdTCPConnection, IdIOHandler;

type
  TIdCmdTCPServer = class(IdCmdTCPServer.TIdCmdTCPServer)
  protected
    procedure InitComponent; override;
    procedure DoExecute(AContext: TIdContext): Boolean; override;
  end;

  TCameraComponentForm = class(TForm)
    CameraComponent1: TCameraComponent;
    btnStartCamera: TButton;
    imgCameraView: TImage;
    btnFrontCamera: TSpeedButton;
    btnBackCamera: TSpeedButton;
    Memo1: TMemo;
    IdCmdTCPServer1: TIdCmdTCPServer;
    procedure btnStartCameraClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CameraComponent1SampleBufferReady(Sender: TObject;
      const ATime: TMediaTime);
    procedure btnFrontCameraClick(Sender: TObject);
    procedure btnBackCameraClick(Sender: TObject);
    procedure IdCmdTCPServer1Connect(AContext: TIdContext);
    procedure IdCmdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdCmdTCPServer1CommandHandlers0Command(ASender: TIdCommand);
  private
    { Private declarations }
    Enable_Stream: Boolean;
    Image_Updated: TIdTicks;
    procedure GetImage;
  public
    { Public declarations }
    function AppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean;
  end;

var
  CameraComponentForm: TCameraComponentForm;

implementation

{$R *.fmx}
{$R *.NmXhdpiPh.fmx ANDROID}

uses
  IdYarn;

type
  TMyContext = class(TIdServerContext)
  public
    LastUpdate: TIdTicks;
    Img: TMemoryStream;
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;
  end;

procedure TCameraComponentForm.FormCreate(Sender: TObject);
var
  AppEventSvc: IFMXApplicationEventService;
begin
  Enable_Stream := False;
  Image_Updated := 0;

  { by default, we start with Front Camera and Flash Off }
  CameraComponent1.Kind := FMX.Media.TCameraKind.ckFrontCamera;
  if CameraComponent1.HasFlash then
    CameraComponent1.FlashMode := FMX.Media.TFlashMode.fmFlashOff;
  CameraComponent1.CaptureSettingPriority := TVideoCaptureSettingPriority.FrameRate;
  { Add platform service to see camera state. }
  if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, IInterface(AppEventSvc)) then
    AppEventSvc.SetApplicationEventHandler(AppEvent);

  // Start server
  IdCmdTCPServer1.Active := True;
end;

{ Make sure the camera is released if you're going away.}

function TCameraComponentForm.AppEvent(AAppEvent: TApplicationEvent;
  AContext: TObject): Boolean;
begin
  case AAppEvent of
    TApplicationEvent.WillBecomeInactive:
      CameraComponent1.Active := False;
    TApplicationEvent.EnteredBackground:
      CameraComponent1.Active := False;
    TApplicationEvent.WillTerminate:
      CameraComponent1.Active := False;
  end;
end;

procedure TCameraComponentForm.btnBackCameraClick(Sender: TObject);
begin
  { select Back Camera }
  CameraComponent1.Active := False;
  CameraComponent1.Kind := FMX.Media.TCameraKind.BackCamera;
  CameraComponent1.Active := True;
end;

procedure TCameraComponentForm.btnFrontCameraClick(Sender: TObject);
begin
  { select Front Camera }
  CameraComponent1.Active := False;
  CameraComponent1.Kind := FMX.Media.TCameraKind.FrontCamera;
  CameraComponent1.Active := True;
end;

procedure TCameraComponentForm.btnStartCameraClick(Sender: TObject);
begin
  { turn on/off the Camera }
  CameraComponent1.Active := not CameraComponent1.Active;
end;

procedure TCameraComponentForm.CameraComponent1SampleBufferReady(
  Sender: TObject; const ATime: TMediaTime);
begin
  // Update the TImage. Call GetImage() only once to get the
  // latest sample buffer in case this event is triggered
  // multiple times before GetImage() is called...
  TThread.RemoveQueuedEvents(nil, GetImage);
  TThread.Queue(nil, GetImage);
end;

procedure TCameraComponentForm.GetImage;
begin
  CameraComponent1.SampleBufferToBitmap(imgCameraView.Bitmap, True);
  imgCameraView.Repaint;
  Image_Updated := Ticks64;
  //imgCameraView.Width := imgCameraView.Bitmap.Width;
  //imgCameraView.Height := imgCameraView.Bitmap.Height;
end;

procedure TCameraComponentForm.IdCmdTCPServer1CommandHandlers0Command(
  ASender: TIdCommand);
begin
  TThread.Queue(nil,
    procedure
    begin
      Memo1.Lines.Add('Send Stream');
    end
  );
  Enable_Stream := True;
end;

procedure TCameraComponentForm.IdCmdTCPServer1Connect(AContext: TIdContext);
var
  str: string;
begin
  str := 'Connection being made - '+ AContext.Binding.PeerIP;
  TThread.Queue(nil,
    procedure
    begin
      Memo1.Lines.Add(str);
    end
  );
end;

procedure TCameraComponentForm.IdCmdTCPServer1Disconnect(AContext: TIdContext);
var
  str: string;
begin
  str := 'Disconnection being made - '+ AContext.Binding.PeerIP;
  TThread.Queue(nil,
    procedure
    begin
      Memo1.Lines.Add(str);
    end
  );
end;

constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited Create(AConnection, AYarn, AList);
  Img := TMemoryStream.Create;
end;

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

procedure TIdCmdTCPServer.InitComponent;
begin
  inherited InitComponent;
  ContextClass := TMyContext;
end;

procedure TIdCmdTCPServer.DoExecute(AContext: TIdContext): Boolean;
var
  LContext: TMyContext;
  LTicks: TIdTicks;
begin
  Result := True;

  if AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    AContext.Connection.IOHandler.CheckForDataOnSource(10);
    AContext.Connection.IOHandler.CheckForDisconnect;
  end;
  if not LContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    Result := inherited DoExecute(AContext); // process a pending command
    if not Result then Exit; // disconnected
  end;

  if not Enable_Stream then Exit;

  LContext := TMyContext(AContext);

  LTicks := Image_Updated;
  if LContext.LastUpdate = LTicks then Exit;
  LContext.LastUpdate := LTicks;

  LContext.Img.Clear;
  TThread.Synchronize(nil,
    procedure
    begin
      CameraComponentForm.imgCameraView.Bitmap.SaveToStream(LContext.Img);
    end
  );

  AContext.Connection.IOHandler.WriteLn('Stream');
  AContext.Connection.IOHandler.Write(LContext.Img, 0, True);

  Result := AContext.Connection.Connected;
end;

end.