main.pas

如何在Delphi下实现画面捕捉、传输、以及文件的传输原理

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DSPack, StdCtrls, DirectShow9, DSUtil, Buttons,
  ComCtrls, IdSocketHandle, IdBaseComponent, IdComponent, IdUDPBase,
  IdUDPServer, IdStackConsts, IdUDPClient, ACMIn, ACMConvertor, DSCNSend,
  DSCNRecv;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    ListBox1: TListBox;
    Label9: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Label10: TLabel;
    Label11: TLabel;
    OpenDialog1: TOpenDialog;
    IdUDPServer1: TIdUDPServer;
    Label12: TLabel;
    Edit1: TEdit;
    Label13: TLabel;
    ACMIn1: TACMIn;
    IdUDPClient1: TIdUDPClient;
    Label14: TLabel;
    ComboBox1: TComboBox;
    DSCNSender1: TDSCNSender;
    DSCNReceiver1: TDSCNReceiver;
    DSCNReceiver2: TDSCNReceiver;
    DSCNReceiver3: TDSCNReceiver;
    Label15: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure Label10Click(Sender: TObject);
    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure ACMIn1BufferFull(Sender: TObject; Data: Pointer;
      Size: Integer);
    procedure ComboBox1Change(Sender: TObject);
    procedure DSCNSender1DblClick(Sender: TObject);
    procedure DSCNSender1DSOnCaptureRate(Sender: TObject; Rate: Single);
    procedure DSCNSender1DSTransmitters0StartSend(Sender: TObject;
      Success: Boolean);
    procedure DSCNSender1DSTransmitters0StopSend(Sender: TObject;
      Success: Boolean);
    procedure DSCNSender1DSTransmitters0SendRates(Sender: TObject; Fps,
      Bps: Single);
    procedure DSCNReceiver1DSOnFeedback(Sender: TObject; Buffer: Pointer;
      Count: Integer);
    procedure DSCNReceiver1DSOnReceiveRates(Sender: TObject; Fps,
      Bps: Single);
    procedure DSCNSender1DSTransmitters0SendBuffer(Sender: TObject;
      Buffer: Pointer; Count, FrameID: Integer);
    procedure Label15Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private declarations }
    DestIP: string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  BufferSize: Integer;
begin
  DestIP := '';
  BufferSize := $40000;
  IdUDPServer1.Binding.SetSockOpt(Id_SOL_SOCKET, Id_SO_SNDBUF, PChar(@BufferSize), SizeOf(BufferSize));
  BufferSize := $40000;
  IdUDPServer1.Binding.SetSockOpt(Id_SOL_SOCKET, Id_SO_RCVBUF, PChar(@BufferSize), SizeOf(BufferSize));

  ListBox1.Items.Text := DSCNSender1.Devices.Text;
  if ListBox1.Count > 0 then
  begin
    ListBox1.ItemIndex := 0;
    DSCNSender1.DSDeviceID := ListBox1.ItemIndex;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if SpeedButton1.Down then
  begin
    ListBox1.Enabled := False;
    DSCNSender1.DSDeviceID := ListBox1.ItemIndex;
    DSCNSender1.StartCapture;
  end
  else
  begin
    ListBox1.Enabled := True;
    DSCNSender1.StopCapture;
  end;
end;

procedure TForm1.Label10Click(Sender: TObject);
begin
  SpeedButton2.Down := False;
  SpeedButton2Click(SpeedButton2);
  SpeedButton3.Down := False;
  SpeedButton2Click(SpeedButton3);
  SpeedButton4.Down := False;
  SpeedButton2Click(SpeedButton4);
  Application.ProcessMessages;
  SpeedButton2.Down := True;
  SpeedButton2Click(SpeedButton2);
  SpeedButton3.Down := True;
  SpeedButton2Click(SpeedButton3);
  SpeedButton4.Down := True;
  SpeedButton2Click(SpeedButton4);
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  GSM610Format:TACMWaveFormat;
begin
  if (Sender as TSpeedButton).Name = 'SpeedButton2' then
  begin
    if SpeedButton2.Down then
    begin
      ComboBox1.Enabled := False;
      DestIP := Edit1.Text;
      with GSM610Format.Format  do
      begin
         wFormatTag:=$31;
         nChannels:=1;
         wBitsPerSample:=0;
         nSamplesPerSec:=8000;
         nBlockAlign:=65;
         nAvgBytesPerSec:=1625;
         cbSize:=2;
      end;
      GSM610Format.RawData[18]:=$40;
      GSM610Format.RawData[19]:=$1;
      try
        ACMIN1.Open(GSM610Format);
      except
      end;
    end
    else
    begin
      ComboBox1.Enabled := True;
      ACMIN1.Close;
    end;
  end;
  if (Sender as TSpeedButton).Down then
    DSCNSender1.DSTransmitters[(Sender as TSpeedButton).Tag].StartSend
  else
    DSCNSender1.DSTransmitters[(Sender as TSpeedButton).Tag].StopSend;
end;

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  Len: Integer;
  Buf: array[0..8191] of Byte;
begin
  Len := AData.Size;
  if Len > 0 then
  begin
    AData.Read(Buf, Len);
    DSCNSender1.DSTransmitters[0].Feedback(@Buf, Len);
  end;
end;

procedure TForm1.ACMIn1BufferFull(Sender: TObject; Data: Pointer;
  Size: Integer);
begin
  if DestIP <> '' then
    IdUDPClient1.SendBuffer(DestIP, 12304, Data^, Size);
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  case ComboBox1.ItemIndex of
    0: DSCNSender1.DSTransmitters.Items[0].SendMode := smExP2P;
    1: DSCNSender1.DSTransmitters.Items[0].SendMode := smP2P;
    2: DSCNSender1.DSTransmitters.Items[0].SendMode := smBroadcast;
  end;
end;

procedure TForm1.DSCNSender1DblClick(Sender: TObject);
begin
  (Sender as TVideoWindow).FullScreen := not (Sender as TVideoWindow).FullScreen;
end;

procedure TForm1.DSCNSender1DSOnCaptureRate(Sender: TObject; Rate: Single);
begin
  if Rate > 0.001 then
    Label8.Caption := IntToStr(Round(Rate)) + 'fps'
  else
    Label8.Caption := '';
end;

procedure TForm1.DSCNSender1DSTransmitters0StartSend(Sender: TObject;
  Success: Boolean);
var
  I: Integer;
begin
  I := StrToInt((Sender as TDSCNTransmitter).Name);
  Case I of
    1: SpeedButton2.Down := Success;
    2: SpeedButton3.Down := Success;
    3: SpeedButton4.Down := Success;
  end;
end;

procedure TForm1.DSCNSender1DSTransmitters0StopSend(Sender: TObject;
  Success: Boolean);
var
  I: Integer;
begin
  I := StrToInt((Sender as TDSCNTransmitter).Name);
  Case I of
    1: begin
      SpeedButton2.Down := not Success;
      SpeedButton2Click(SpeedButton2);
    end;
    2: SpeedButton3.Down := not Success;
    3: SpeedButton4.Down := not Success;
  end;

end;

procedure TForm1.DSCNSender1DSTransmitters0SendRates(Sender: TObject; Fps,
  Bps: Single);
var
  AFps, ABps: Integer;
begin
  AFps := Round(Fps);
  ABps := Round(Bps);
  Label14.Caption := IntToStr(AFps) + 'Fps,' + IntToStr(ABps) + 'Kbps';
end;

//这个是模拟在P2P的发送模式下接收端反馈数据到发送端的过程
//在这个事件中，输出反馈数据并发送到网络去传回给发送端。
procedure TForm1.DSCNReceiver1DSOnFeedback(Sender: TObject;
  Buffer: Pointer; Count: Integer);
begin
  Case (Sender as TDSCNReceiver).Tag of
    //第一和第二路传送器使用P2P的发送模式，所以需要接收反馈数据
    //而第三路是用于广播的，所以没有反馈数据
    1: DSCNSender1.DSTransmitters[0].Feedback(Buffer, Count);
    2: DSCNSender1.DSTransmitters[1].Feedback(Buffer, Count);
  end;
end;

procedure TForm1.DSCNReceiver1DSOnReceiveRates(Sender: TObject; Fps,
  Bps: Single);
var
  S: string;
begin
  if Fps > 0.0001 then
    S := IntToStr(Round(Fps)) + 'fps'
  else
    S := '';
  Case (Sender as TDSCNReceiver).Tag of
    1: Label4.Caption := S;
    2: Label5.Caption := S;
    3: Label6.Caption := S;
  end;
end;

/////////////////////////////////////
//这个是模拟发送和接收的过程。
//在这个事件中，输出已分包的压缩视频的数据，并把他们发送到网络去；
procedure TForm1.DSCNSender1DSTransmitters0SendBuffer(Sender: TObject;
  Buffer: Pointer; Count, FrameID: Integer);
var
  I: Integer;
begin
  I := StrToInt((Sender as TDSCNTransmitter).Name);
  Case I of
    //三方通过网络接收以后把分包数据送入DSCNReceiver
    1: begin
      //DSCNReceiver1.WriteBuffer(Buffer, Count);
      if DestIP <> '' then
        IdUDPServer1.Binding.SendTo(DestIP, 12302, Buffer^, Count);
    end;
    2: DSCNReceiver2.WriteBuffer(Buffer, Count);
    3: DSCNReceiver3.WriteBuffer(Buffer, Count);
  end;
end;

procedure TForm1.Label15Click(Sender: TObject);
begin
  DSCNSender1.SetVideoSourceProperty;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  if ListBox1.ItemIndex >= 0 then
    DSCNSender1.DSDeviceID := ListBox1.ItemIndex;
end;

end.