Delphi Firemonkey TVideoCaptureDevice来自客户端 - 服务器 - 客户端的实时流

时间:2016-02-25 21:39:44

标签: delphi firemonkey tcpclient indy tcpserver

我一直在努力向客户端 - 服务器 - 客户端发送/接收TVideoCaptureDevice Live Stream。我正在使用TIdTCPServer和TIdTCPClient。当试图接收我正在优雅地关闭Connection。如何克服Connection正常关闭? 以下是我的代码:

服务器

// for send

procedure TWebSocket.videoSendServerExecute(AContext: TIdContext);
var
  fip: string;
  ms: TMemoryStream;
  cmd: string;
begin
  cmd := AContext.Connection.IOHandler.ReadLn(IndyTextEncoding_UTF8);
  if AContext.Connection.Connected then
  begin
    fip := cmd;//AContext.Connection.Socket.Binding.PeerIP;
    fip := Copy(fip, Pos(':', fip) + 1, Length(fip));
    ms := vWebcamCollection.GetItem(vWebcamCollection.GetIndexByIP(fip)).StartedStream;
    ms.Position := 0;
    AContext.Connection.IOHandler.LargeStream := True;
    AContext.Connection.IOHandler.ReadStream(ms);
    AContext.Connection.IOHandler.WriteLn('DONE', IndyTextEncoding_UTF8);
  end;
end;

// for receive

procedure TWebSocket.videoReceiveServerExecute(AContext: TIdContext);
var
  ms: TMemoryStream;
  cmd, viewip: string;
begin
  cmd := AContext.Connection.IOHandler.ReadLn;
  viewip := cmd;
  viewip := Copy(viewip, Pos(':', viewip) + 1, Length(viewip));
  ms := vWebcamCollection.GetItem(vWebcamCollection.GetIndexByIP(viewip)).StartedStream;
  ms.Position := 0;
  AContext.Connection.IOHandler.LargeStream := True;
  AContext.Connection.IOHandler.Write(ms, 0, True);
  AContext.Connection.IOHandler.WriteLn('DONE', IndyTextEncoding_UTF8);
end;

客户端

两个计时器间隔为500 //用于在TTimer.OnTimer中发送流

procedure TfrmVideoForm.sendTimerTimer(Sender: TObject);
begin
  sendTimer.Enabled := False;
  TThread.Synchronize(TThread.CurrentThread, (
    procedure
    var
      aIp: String;
      ms: TMemoryStream;
    begin
      aIp := getLocalIPAddress;
      aIp := Format('send:%s', [aIp]);
      videoClient.IOHandler.WriteLn(aIp, IndyTextEncoding_UTF8);
      ms := TMemoryStream.Create;
      videoClient.IOHandler.LargeStream := True;
      imgVideo.Bitmap.SaveToStream(ms);
      ms.Position := 0;
      videoClient.IOHandler.Write(ms, 0, True);
      videoClient.IOHandler.ReadLn(IndyTextEncoding_UTF8);
    end));
  sendTimer.Enabled := True;
end;

//用于接收流 - fIPAddress =哪个IPAddress启动TVideoCaptureDevice

procedure TfrmVideoForm.receiveTimerTimer(Sender: TObject);
begin
  receiveTimer.Enabled := False;
  TThread.Synchronize(TThread.CurrentThread, (
    procedure
    var
      strm: TMemoryStream;
    begin
      videoRcvClient.IOHandler.WriteLn('receive:' + fIPAddress,
        IndyTextEncoding_UTF8);
      strm := TMemoryStream.Create;
      videoRcvClient.IOHandler.LargeStream := True;
      videoRcvClient.IOHandler.ReadStream(strm);
      videoRcvClient.IOHandler.ReadLn(IndyTextEncoding_UTF8);
      strm.Position := 0;
      imgVideo.Bitmap.LoadFromStream(strm);
      strm.Free;
    end));
  receiveTimer.Enabled := True;
end;

服务器持有IP地址

的代码
  { TWebcamItem }

  TWebcamItem = class(TCollectionItem)
  private
    fStartedIP: string;
    fStartedStream: TMemoryStream;
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(ACollection: TCollection); override;
    destructor Destroy; override;
    property StartedIP: string read fStartedIP write fStartedIP;
    property StartedStream: TMemoryStream read fStartedStream write fStartedStream;
    procedure CreateStream;
    procedure FreeStream;
  end;

  { TWebcamCollection }

  TWebcamCollection = class(TCollection)
  private
    function GetItem(Index: integer): TWebcamItem;
    procedure SetItem(Index: integer; AValue: TWebcamItem);
  public
    constructor Create;
    function Add: TWebcamItem;
    property Items[Index: integer]: TWebcamItem read GetItem write SetItem; default;
    function GetIndexByIP(AIP: string): integer;
  end;

0 个答案:

没有答案