网络MPEG4视频传输(基于Xvid库)Demo

//*****************************************服务器接收代码*******************************************

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer,
  DSPack,lib_xvid;

type
  TForm1 = class(TForm)
    idtcpsrvr1: TIdTCPServer;
    btn1: TButton;
    img1: TImage;
    mmo1: TMemo;
    btn2: TButton;
    lbl1: TLabel;
    tmr1: TTimer;
    procedure btn1Click(Sender: TObject);
    procedure idtcpsrvr1Connect(AThread: TIdPeerThread);
    procedure idtcpsrvr1Execute(AThread: TIdPeerThread);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btn2Click(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure idtcpsrvr1Disconnect(AThread: TIdPeerThread);
  private
    { Private declarations }
    xvid_Version:Integer;
    xvid_gbl: xvid_gbl_init_t;
        
    xVid_decode  : xvid_dec_create_t;
    xvid_decFrame: xvid_dec_frame_t;
  public
    { Public declarations }

  end;
  type
    TimgSendBuf = packed record
      ImgSize:Word;
      Buffer:array [0..352*288*3] of Byte;
    end;
var
  Form1: TForm1;
  imgSendBuf:TimgSendBuf;
  FrameImg:array [0..352*288*3 ] of Byte;
  FrameCount : LongWord = 0;
  FrameBytes : LongWord = 0;
  PerFrame : LongWord= 0;
  PerFrameBytes : LongWord =0;
implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
begin
  idtcpsrvr1.DefaultPort := 9001;
  idtcpsrvr1.Active := True;
  mmo1.Lines.Add('服务启动！');
end;

procedure TForm1.idtcpsrvr1Connect(AThread: TIdPeerThread);
begin
  mmo1.Lines.Add('有客户端连接！');
end;

procedure TForm1.idtcpsrvr1Execute(AThread: TIdPeerThread);
var
  SpBmp:TBitmap;
  Ret:Integer;
    BIInfo: TBitmapInfo;
    BitmapHandle: HBitmap;
    DIBPtr: Pointer;
    DIBSize: LongInt;
begin
  try
    SpBmp := TBitmap.Create;
    AThread.Connection.ReadBuffer(imgSendBuf.ImgSize,2);
    AThread.Connection.ReadBuffer(imgSendBuf.Buffer,imgSendBuf.ImgSize);
    
    //初始化解码数据帧结构
    xvid_decFrame.version := xvid_Version;
    xvid_decFrame.general := 0;
    xvid_decFrame.bitstream := @imgSendBuf.Buffer[0];   //输入解压的位流
    xvid_decFrame.length := imgSendBuf.ImgSize;         //输入位流长度
    xvid_decFrame.output.csp := XVID_CSP_BGR;  //色彩空间
    xvid_decFrame.output.plane[0] := @FrameImg[0];   //解压后输出的缓冲区
    xvid_decFrame.output.stride[0] := 320 * 3;       //每行字节数
    ret := xvid_decore(xVid_decode.handle , XVID_DEC_DECODE, @xvid_decFrame, nil);
    //mmo1.Lines.Add('Img:'+ IntToStr(imgSendBuf.ImgSize) + ' Ret=:' + IntToStr(Ret));
       //从视频缓冲区中取得当前位图
       BIInfo.bmiHeader.biSize := 40; // SizeOf(TBitmapInfoHeader);
       BIInfo.bmiHeader.biWidth := 320;
       BIInfo.bmiHeader.biHeight := 240;
       BIInfo.bmiHeader.biPlanes := 1;
       BIInfo.bmiHeader.biBitCount := 24;
       BIInfo.bmiHeader.biCompression := 0;
       BIInfo.bmiHeader.biSizeImage := 320 * 240 * 3;
       BIInfo.bmiHeader.biXPelsPerMeter := 0;
       BIInfo.bmiHeader.biYPelsPerMeter := 0;
       BIInfo.bmiHeader.biClrUsed := 0;
       BIInfo.bmiHeader.biClrImportant := 0;
       BitmapHandle := CreateDIBSection(0, BIInfo,DIB_RGB_COLORS, DIBPtr, 0, 0);
       Move(FrameImg, DIBPtr^, BIInfo.bmiHeader.biSizeImage );
       SpBmp.Handle := BitmapHandle;
       Img1.Canvas.Lock; 
       Img1.Canvas.Draw(0,0,SpBmp);
       Img1.Canvas.Unlock;    

    Inc(FrameCount);      //接收的帧
    FrameBytes := FrameBytes + imgSendBuf.ImgSize + 2; //接收的字节
  finally
    DeleteObject(BitmapHandle);
    SpBmp.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //XVID库初始化操作
  xvid_Version :=XVID_MAKE_VERSION(1,1,0);  
  xvid_gbl.version := xvid_Version;    //Version:1.1.0
  xvid_gbl.cpu_flags := Word(XVID_CPU_FORCE or XVID_CPU_ASM);//0:自动检查CPU，XVID_CPU_FORCE or XVID_CPU_ASM：强制使用ASM汇编优化
  xvid_gbl.debug := 0;     //调试级别

  //初始化编解码
  xvid_global(nil, XVID_GBL_INIT, @xvid_gbl, nil);

  xVid_decode.version := xvid_Version;
  xVid_decode.width := 320;
  xVid_decode.height := 240;
 //创建解码器
  xvid_decore(nil,XVID_DEC_CREATE,@xVid_decode, nil);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 if  Assigned(xVid_decode.handle) then
  xvid_decore(xVid_decode.handle,XVID_DEC_DESTROY,@xvid_decode,nil);
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  idtcpsrvr1.Active := False;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
begin
  PerFrame := FrameCount - PerFrame;
  PerFrameBytes := (FrameBytes - PerFrameBytes) div 1024;
  lbl1.Caption := '当前流量：' +  IntToStr(PerFrame) + '帧/秒' + IntToStr(PerFrameBytes) +  'k/秒';
  PerFrameBytes := FrameBytes;
  PerFrame := FrameCount;
end;

procedure TForm1.idtcpsrvr1Disconnect(AThread: TIdPeerThread);
begin
 mmo1.Lines.Add('客户端断开连接！');
end;

end.

 

//*****************************************客户端发送视频部分*************************************************

unit main;

interface

uses   
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DSUtil, StdCtrls, DSPack, DirectShow9, Menus, ExtCtrls,lib_xvid,
  IdBaseComponent, IdComponent, IdTCPServer,IdGlobal, IdTCPConnection,
  IdTCPClient, IdThreadMgr, IdThreadMgrDefault, IdAntiFreezeBase,
  IdAntiFreeze;

type
  TVideoForm = class(TForm)
    FilterGraph: TFilterGraph;
    VideoWindow: TVideoWindow;
    MainMenu1: TMainMenu;
    Devices: TMenuItem;
    Filter: TFilter;
    Image: TImage;
    SampleGrabber: TSampleGrabber;
    SnapShot: TButton;
    CallBack: TCheckBox;
    mmo1: TMemo;
    lbl1: TLabel;
    idtcpclnt1: TIdTCPClient;
    btn1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SnapShotClick(Sender: TObject);
    procedure SampleGrabberBuffer(sender: TObject; SampleTime: Double;
      pBuffer: Pointer; BufferLen: Integer);

  private
    // XVID ENCODER
    xvid_gbl: xvid_gbl_init_t;
    xvid_enc     : xvid_enc_create_t;
    xvid_encFrame: xvid_enc_frame_t;
    xvid_encStats: xvid_enc_stats_t;

  public
    procedure OnSelectDevice(sender: TObject);
  end;

  type
    TimgSendBuf = packed record
      ImgSize:Word;
      Buffer:array [0..352*288*3] of Byte;
    end;
var
  VideoForm: TVideoForm;
  SysDev: TSysDevEnum;
  FrameBuf:array [0..352*288*3 ] of Byte;
  FrameImg:array [0..352*288*3 ] of Byte;
  FrameSequece : LongWord= 0;
  xvid_Version:Integer;
  FrameByteCount : LongWord = 0;
  CurFrame: LongWord = 0;
  Sending:BOOL=False;
  imgSendBuf:TimgSendBuf;
implementation

{$R *.dfm}

procedure TVideoForm.FormCreate(Sender: TObject);
var
  i: integer;
  Device: TMenuItem;
begin
  xvid_Version :=XVID_MAKE_VERSION(1,1,0);
  SysDev:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  if SysDev.CountFilters > 0 then
    for i := 0 to SysDev.CountFilters - 1 do
    begin
      Device := TMenuItem.Create(Devices);
      Device.Caption := SysDev.Filters[i].FriendlyName;
      Device.Tag := i;
      Device.OnClick := OnSelectDevice;
      Devices.Add(Device);
    end;
end;

procedure TVideoForm.OnSelectDevice(sender: TObject);
begin
  Self.DoubleBuffered := True;
  FilterGraph.ClearGraph;
  FilterGraph.Active := false;
  Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
  FilterGraph.Active := true;
  with FilterGraph as ICaptureGraphBuilder2 do
  begin
    RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, SampleGrabber as IBaseFilter, VideoWindow as IbaseFilter);
  end;
  try
      //XVID库初始化操作
      xvid_gbl.version := xvid_Version;    //Version:1.1.0
      xvid_gbl.cpu_flags := Word(XVID_CPU_FORCE or XVID_CPU_ASM);//0:自动检查CPU，XVID_CPU_FORCE or XVID_CPU_ASM：强制使用ASM汇编优化
      xvid_gbl.debug := 0;     //调试级别

      //初始化编解码
      xvid_global(nil, XVID_GBL_INIT, @xvid_gbl, nil);

      // XVID编码器初始化
      xvid_enc.version := xvid_Version;
      //编码器参数
      xvid_enc.global := XVID_GLOBAL_PACKED;   //全局标志
      xvid_enc.width := 320;  //压缩视频宽度
      xvid_enc.height := 240; //压缩视频高度
      xvid_enc.fbase := 3;    //基本帧率/每秒  = fbase * 10 = 30
      xvid_enc.fincr := 1;    //帧率增长步长，0：可变步长，>1实际增长步长
      xvid_enc.profile := XVID_PROFILE_AS_L4; //压缩级别，MPEG4-ASP最高压缩级别
      xvid_enc.max_key_interval := 0;  //最大关键帧间隔
      xvid_enc.frame_drop_ratio := 0;  //丢帧率；0~100
      xvid_enc.max_bframes := 0; //是否采用B帧，一般采用I，P帧，如果1=PB帧
      xvid_enc.bquant_offset := 0;
      xvid_enc.bquant_ratio := 0;

      //创建编码器
      xvid_encore(nil, XVID_ENC_CREATE, @xvid_enc, nil);
      //初始化压缩数据帧结构
      xvid_encFrame.version := xvid_Version;
      // --- VOL FLAGS
      xvid_encFrame.vol_flags :=  0;//XVID_VOL_MPEGQUANT OR XVID_VOL_QUARTERPEL OR XVID_VOL_GMC;
      // --- VOP FLAGS
      xvid_encFrame.vop_flags := 0;//XVID_VOP_HALFPEL or XVID_VOP_INTER4V;
      
      xvid_encFrame.motion := 0;//XVID_ME_ADVANCEDDIAMOND16 or XVID_ME_HALFPELREFINE16 or
                              //XVID_ME_ADVANCEDDIAMOND8 or XVID_ME_HALFPELREFINE8;  //运动估计
      xvid_encFrame.quant := 4; //质量控制=量化参数，0~31，数值越小质量越高和码率成反比

      xvid_encFrame.coding_type := XVID_TYPE_AUTO;  //XVID_TYPE_AUTO=让编码器自动决定，I帧编码是关键帧，P帧编码是帧内预测

      
  except
    Exit;
  end;
  FilterGraph.Play;
end;

procedure TVideoForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CallBack.Checked := False;
  SysDev.Free;
  FilterGraph.ClearGraph;
  FilterGraph.Active := false;
  //关闭编解码器
  if  Assigned(xvid_enc.handle) then
  xvid_encore(xvid_enc.handle,XVID_ENC_DESTROY, @xvid_enc, nil);

end;

procedure TVideoForm.SnapShotClick(Sender: TObject);
begin
    idtcpclnt1.Disconnect;
    idtcpclnt1.Host:='127.0.0.1';
    idtcpclnt1.Port:=9001;
    idtcpclnt1.Connect;
end;

procedure TVideoForm.SampleGrabberBuffer(sender: TObject;
  SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
var
  SpBmp:TBitmap;
  Ret:Integer;
begin
  if CallBack.Checked then
  begin

    try
      xvid_encFrame.bitstream := @FrameBuf[0];
      xvid_encFrame.input.csp := XVID_CSP_BGR; //输入是rgb位图
      xvid_encFrame.input.plane[0] := pBuffer; //RGB位图数据，每个像素有3个字节,(R,G,B)
      xvid_encFrame.input.stride[0] := 320 * 3; //每行字节数

      
      //开始压缩
      //Ret := xvid_encore(xvid_enc.handle, XVID_ENC_ENCODE, @xvid_encFrame,@xvid_encStats); //返回编码之后的字节
      Ret := xvid_encore(xvid_enc.handle, XVID_ENC_ENCODE, @xvid_encFrame,nil); //返回编码之后的字节

      //网络发送
      if idtcpclnt1.Connected then
      begin
        imgSendBuf.ImgSize := Ret;
        Move(FrameBuf,imgSendBuf.Buffer,Ret);
        idtcpclnt1.WriteBuffer(imgSendBuf,Ret+2,True);
      end; 
    except

    end;
  end;
end;

end.