main.pas

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

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, IdStackConsts, DSPack,
  DSNRecv, IdSocketHandle, StdCtrls, ACMOut, ACMConvertor, DSCNRecv;

type
  TForm1 = class(TForm)
    IdUDPServer1: TIdUDPServer;
    IdUDPServer2: TIdUDPServer;
    ACMConvertor1: TACMConvertor;
    ACMOut1: TACMOut;
    Button1: TButton;
    Button2: TButton;
    DSCNReceiver1: TDSCNReceiver;
    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure FormCreate(Sender: TObject);
    procedure IdUDPServer2UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure DSCNReceiver1DblClick(Sender: TObject);
    procedure DSCNReceiver1DSOnFeedback(Sender: TObject; Buffer: Pointer;
      Count: Integer);
    procedure DSCNReceiver1DSOnReceiveRates(Sender: TObject; Fps,
      Bps: Single);
  private
    { Private declarations }
    HasSound: Boolean;
    IP: string;
    Port: Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  BufferSize: Integer;
begin
  IP := '';
  Port := 0;
  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));
  BufferSize := $40000;
  IdUDPServer2.Binding.SetSockOpt(Id_SOL_SOCKET, Id_SO_SNDBUF, PChar(@BufferSize), SizeOf(BufferSize));
  BufferSize := $40000;
  IdUDPServer2.Binding.SetSockOpt(Id_SOL_SOCKET, Id_SO_RCVBUF, PChar(@BufferSize), SizeOf(BufferSize));
  HasSound := False;
  try
    ACMOut1.Open(ACMConvertor1.FormatOut);
    HasSound := True;
  except
  end;
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);
    if (IP <> ABinding.PeerIP) or (Port <> ABinding.PeerPort) then
    begin
      IP := ABinding.PeerIP;
      Port := ABinding.PeerPort;
    end;
    DSCNReceiver1.WriteBuffer(@Buf, Len);
  end;
end;

procedure TForm1.IdUDPServer2UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  Len: Integer;
  Buf: array[0..8191] of Byte;
  I, Max, Min:integer;
  cData:Array [0..10000] of byte;
  OutSize: Integer;
begin
  if not HasSound then Exit;
  Len := AData.Size;
  if Len > 0 then
  begin
    AData.Read(Buf, Len);
    ACMConvertor1.Open(@Buf, Len);
    OutSize := ACMConvertor1.Convert ;
    if OutSize <= 0 then Exit;
    Move(ACMConvertor1.BufferOut^, cData, ACMconvertor1.OutputBufferSize);
    Max := 0;
    Min := 1000;
    for  I:=0 to ACMconvertor1.OutputBufferSize - 1 do
    begin
      if cdata[i] > Max then Max := cdata[i];
      if cdata[i] < Min then Min := cdata[i];
    end;
    if Max > 130 then
      ACMout1.Play(ACMConvertor1.BufferOut, ACMconvertor1.OutputBufferSize);
  end;
end;

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

procedure TForm1.Button1Click(Sender: TObject);
begin
  DSCNReceiver1.DSTextOnWindows.ShowAllText;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DSCNReceiver1.DSTextOnWindows.ErasureAllText;
end;

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

procedure TForm1.DSCNReceiver1DSOnFeedback(Sender: TObject;
  Buffer: Pointer; Count: Integer);
begin
  if IP <> '' then
    IdUDPServer1.Binding.SendTo(IP, Port, Buffer^, Count);
end;

procedure TForm1.DSCNReceiver1DSOnReceiveRates(Sender: TObject; Fps,
  Bps: Single);
var
  S: string;
begin
  S := 'Video Receiver(' + IntToStr(Round(Fps)) + 'Fps,' + IntToStr(Round(Bps)) + 'Kbps)';
  Caption := S;
end;

end.