Delphi - отправка потока с использованием IdCmdTCPServer для клиента

Я пытаюсь отправить поток изображений jpg с камеры Android на клиента, используя Indy 10, я получил пример CameraComponent из Delphi, который получает изображение с камеры и показать в TImage, то, что я хотел бы сделать, это отправить этот поток клиенту, используя IdTCPClient.Delphi - отправка потока с использованием IdCmdTCPServer для клиента

Я использую 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 и сервера не синхронизированы, но я не знаю, как решить эту проблему и ускорить приложение.

Любая помощь приветствуется.

источник

2015-06-25 Luiz Alberto Roque

TIdCmdTCPServer - многопоточный компонент. События OnConnect, OnDisconnect и OnCommand запускаются в контексте рабочего потока, созданного для подключенного клиента. Ваши обработчики для этих событий не используют потокобезопасный код, и вы выполняете ввод/вывод сокетов в контексте основного потока пользовательского интерфейса вместо рабочего потока клиента.

Тем не менее, рабочий поток клиента TIdCmdTCPServer обычно блокируется, пока клиент не отправляет команды, и он не позволяет вам вводить ваш собственный код ввода-вывода в течение этого времени простоя. Поэтому вам нужно будет сделать небольшое объявление, чтобы потоки клиентов проверяли TImage на новые изображения и отправляли их без блокировки основного потока пользовательского интерфейса.

Попробуйте что-то вроде этого:

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.

источник

2015-06-25 03:10:49

Привет Remy, спасибо так много для точки меня, кстати, код, который вы сделали работали его, теперь TImage обновляется быстро, пока сервер Безразлично» t есть соединение, потому что, когда соединение выполняется и поток начинает отправляться, скорость обновления изображения снова становится медленной, на сервере и клиенте - почти на 1 кадр за секунду. Видел, мне нужно немного поработать над этими tthreads, мой вопрос: я работаю с IdCmdTCPServer, если я использую IdTCPServer или IdUDPServer может ускорить передачу? Следовательно, скорость обновления изображения. –

Я ничего не знаю о 'TCameraComponent' или о том, как это работает. Если он обновляет изображения с высокой скоростью, повторяющиеся вызовы 'TThread.Synchronize()' скорее всего замедляют работу. Теперь я изменил их на 'TThread.Queue()'. И нет, переход на 'TIdTCPServer' не ускорит что-либо. Переключение на 'TIdUDPServer' или' TIdIPMCastServer' может, хотя, поскольку вы можете отправлять трансляции по подсети/многоадресной рассылке, а не беспокоиться о потоковой передаче. –

Delphi - отправка потока с использованием IdCmdTCPServer для клиента

ответ

Смежные вопросы