堆棧內存溢出
  簡體   English   中英

Delphi-使用IdCmdTCPServer將流發送到客戶端

[英]Delphi - Send stream using IdCmdTCPServer to a Client

 原文  2015-06-25 01:16:18  7   1    android/ multithreading/ delphi/ indy

問題描述

我正在嘗試使用Indy 10將從android攝像頭獲取的jpg圖像流發送到客戶端，我從Delphi獲得了示例CameraComponent，該組件從Camera獲取圖像並顯示在TImage中，我想做的是是使用IdTCPClient將此流發送到客戶端的。

我正在使用IdCmdTCPServer發送流，其中一些客戶端需要數據，但是當我在android系統（Galaxy S4 mini）上運行服務器應用程序時，該應用程序運行太慢，從相機更新顯示的圖像變慢了，我能夠連接到服務器，但是僅發送一個圖像，然后服務器應用程序停止響應。

我認為我的問題與多線程有關，但是我不知道如何解決它。 這是我的代碼。 

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.

我認為CameraComponent和Server中的線程不同步，但是我不知道如何解決它並加快應用程序的速度。

任何幫助表示贊賞。

1 個解決方案

解決方案1
 2 已采納  2015-06-25 03:10:49

TIdCmdTCPServer是一個多線程組件。 在為連接的客戶端創建的輔助線程的上下文中觸發OnConnect ， OnDisconnect和OnCommand事件。 這些事件的處理程序未使用線程安全代碼，並且正在主UI線程而不是客戶端輔助線程的上下文中進行套接字I / O。

但是，在客戶端不發送命令時，通常會阻止TIdCmdTCPServer客戶端工作線程，並且它本身不允許您在該空閑時間內注入自己的I / O代碼。 因此，您將不得不發揮一些創意，讓客戶端線程檢查TImage中的新圖像，並在不阻塞主UI線程的情況下發送它們。

嘗試這樣的事情： 

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.

暫無
暫無

聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

相關問題 使用Websocket將音頻流從Android（客戶端）發送到C＃（服務器） 如何使用 RTP 發送和接收語音流 如何使用 RxJava 發送字節 stream？ 如何使用Delphi XE5中的gmail應用程序發送電子郵件？ 發送電子郵件Delphi XE5 rtsp客戶端流到服務器 使用Delphi xe7將文本從Windows操作系統發送到Android設備 如何使用電子郵件客戶端發送電子郵件？ 使用套接字將服務器JAVA的圖像發送到android客戶端 如何使用TCP服務器客戶端將文件夾中的所有圖像發送到clinet？
相關標簽
 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM