堆栈内存溢出
  繁体   English   中英

Delphi-使用IdCmdTCPServer将流发送到客户端

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

 原文  2015-06-25 01:16:18  3   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