unit1.~pas

基于Delphi的IP电话开发的源代码

unit Unit1;


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, AVPhone3, VBA_TLB, OleCtrls, ExtCtrls, StrUtils,
  OleServer;

type
  TForm1 = class(TForm)
    VidCap1: TVidCap;
    UDPSocket1: TUDPSocket;
    AudCap1: TAudCap;
    AudRnd1: TAudRnd;
    VidCodec1: TVidCodec;
    VidCodec2: TVidCodec;
    AudCodec1: TAudCodec;
    AudCodec2: TAudCodec;
    AVIFile1: TAVIFile;
    VidRnd1: TVidRnd;
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    Button3: TButton;
    ListBox1: TListBox;
    Label1: TLabel;
    VBACollection1: TVBACollection;
    VBAErrObject1: TVBAErrObject;
    procedure FormCreate(Sender: TObject);
    procedure AudCap1Frame(Sender: TObject; var Data: OleVariant);
    procedure VidCodec1Frame(Sender: TObject; var Data: OleVariant;
      IsKeyFrame: WordBool);
    procedure VidCap1Frame(Sender: TObject; var Data: OleVariant);
    procedure AudCodec1Frame(Sender: TObject; var Data: OleVariant);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure UDPSocket1Frame(Sender: TObject; Address : integer;
      Port: Smallint; Handle, Param: Integer; var Data: OleVariant);
    procedure VidCodec2Frame(Sender: TObject; var Data: OleVariant;
      IsKeyFrame: WordBool);
    procedure AudCodec2Frame(Sender: TObject; var Data: OleVariant);
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private declarations }
    procedure EnumAudioDevices();
    procedure ConnectAudio(const Driver : OleVariant);
    procedure ConnectVideo();
    procedure RestoreToLocal();
    procedure CallTo(Host : String);
    procedure Hangup();
    procedure ClearCall();
    procedure EstablishCall(Addr : integer; Port : Smallint);

    procedure StartRecord(Path : String);
    procedure StopRecord();
  public
    { Public declarations }
  end;

const
{message definition}
TM_CALLSETUP = $1;
TM_CALLANSWER = $2;
TM_CALLREJECT = $3;
TM_CALLHANGUP = $4;

TM_AUDIOFORMAT = $10;
TM_AUDIOFRAME = $11;

TM_VIDEOFORMAT = $21;
TM_VIDEOFRAME = $22;
TM_VIDEOFRAMEKEY = $23;
TM_VIDEORATE = $24;

var
  Form1: TForm1;

{are we in a conference}
blnConf : boolean;
{current our state}
lState : integer;
{timeout count}
lCount : integer;
{is recording in progress}
blnRecording : Boolean;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
    Caption := 'AV ICQ';

    {timer engine}
    Timer1.Interval := 1000;

    {bind to socket}
    UDPSocket1.Bind('1720', 0);

    {show our IP}
    Caption := Caption + ' - ' + UDPSocket1.GetIP(UDPSocket1.LocalAddress);

    {set output volume to 25%}
    AudRnd1.Volume := 2525;

    {enum audio device to list box}
    EnumAudioDevices();

    {connect to default audio device}
    ConnectAudio(-1);

    {connect to video if it's available}
    ConnectVideo();

    {start rendering with local audio and video}
    RestoreToLocal();

end;

procedure TForm1.EnumAudioDevices();
var
    i : Smallint;
    vt: OleVariant;
begin
    //get device name collection
    VBACollection1.ConnectTo(_Collection(AudCap1.Devices));

    //read it's name and add to list
    for i := 1 to VBACollection1.Count do
    begin
        vt := Variant(i);
        //add it
        ListBox1.Items.Add(VBACollection1.Item(vt));
        end;
end;

procedure TForm1.ConnectAudio(const Driver : OleVariant);
begin

    try

    {you can select the the device by specifying a substring of name
    of the device, this line will select the first
    {Crystal SoundFusion(tm)' device}
    {AudCap1.Device := 'Crystal';}

    {or by the driver index directly}
    {AudCap1.Device := 0;}

    {connect the device}
    AudCap1.Device := Driver;

    {set audio codec output format, here's using
    GSM610}
    AudCodec1.OutFormat := 'gsm';

    {or your can call the CompressorDlg to select one
    AudCodec1.CompressorDlg();}

    {you can change the audio to any format you want
    by this "silent" way

    AudCap1.Format := 'gsm'
    will select gsm610 codec

    AudCap1.Format := '49'
    also select gsm610 codec because it's FormatTag is 49

    AudCap1.Format := 'true'
    will select the TrueSpeech codec.}

    {set codec input format to audcap's output}
    AudCodec1.InFormat := AudCap1.Format;
    except
    Application.MessageBox('Audio not available.', 'Error', MB_OK + MB_ICONHAND);
    end;
end;


procedure TForm1.ConnectVideo();
begin
    try
    {set video format to QCIF}
    VidCap1.Format := '176,144';

    {connect first available video device}
    VidCap1.Device := -1;

    {you also can select the the device by specifying a substring of name
    of the device, this line will select the first
    'Microsoft WDM Image Capture (Win32)' device}
    //VidCap1.Device := 'WDM';

    {set video codec output format, here's using
    Indeo? video 5.10}
    VidCodec1.OutFormat := 'iv50';

    {or your call call the CompressorDlg to select one
    VidCodec1.CompressorDlg();}

    {set codec quality}
    VidCodec1.Quality := 40;

    {set codec input format to vidcap's output}
    VidCodec1.InFormat := VidCap1.Format;
    except
    Application.MessageBox('Video not available.','Error',MB_OK + MB_ICONHAND);
    end;
end;

procedure TForm1.RestoreToLocal();
begin
    {set audrnd format to the same of audcap}
    AudRnd1.Format := AudCap1.Format;

    {set vidrnd format to the same of vidcap}
    VidRnd1.Format := VidCap1.Format;

    {local video needn't buffer, set to negative value}
    VidRnd1.Rate := -VidCap1.Rate;
end;

procedure TForm1.AudCap1Frame(Sender: TObject; var Data: OleVariant);
begin
    {audio frames captured}
    try
        If blnConf Then
            {if we are in a conference compress it}
            AudCodec1.Frame(Data)
        else
        begin
            {otherwise render it in audrnd control directly}
            AudRnd1.Frame(Data);

            {if local recording in progress compress it}
            If blnRecording Then AudCodec1.Frame(Data);
            end;
    except
    end;
end;

procedure TForm1.AudCodec1Frame(Sender: TObject; var Data: OleVariant);
begin
    try

    If blnConf Then
        {audio frames compressed, send it to remote
        with message handle TM_AUDIOFRAME}
        UDPSocket1.Frame(-1, -1, TM_AUDIOFRAME, 0, Data)

    else
        {write it to avi file}
        AVIFile1.StreamWrite(-1, Data);

    except
    end;
end;

procedure TForm1.VidCap1Frame(Sender: TObject; var Data: OleVariant);
begin
    {video frame captured}
    try
    If blnConf Then
        {if we are in a conference compress it}
        VidCodec1.Frame(Data, True)
    else
    begin
        {otherwise render it in vidrnd control directly}
        VidRnd1.Frame(Data, True);

        {if local recording in progress compress it}
        If blnRecording Then VidCodec1.Frame(Data, True);
        end;
    except
    end;

end;

procedure TForm1.VidCodec1Frame(Sender: TObject; var Data: OleVariant;
  IsKeyFrame: WordBool);
var
    i:integer;
begin
    try

    If blnConf Then
    begin
        {video frame compressed, send it to remote
        with message handle TM_VIDEOFRAME and TM_VIDEOFRAMEKEY}
        if IsKeyFrame then
            i := TM_VIDEOFRAMEKEY
        else
            i := TM_VIDEOFRAME;
        UDPSocket1.Frame(-1, -1, i, 0, Data);
        end

    else
        {write it to avi file}
        AVIFile1.StreamWrite(-2, Data, IsKeyFrame);

    except
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);

var
        s : String;
        i : integer;
begin
    if blnConf then
    begin
        Application.MessageBox('Already in a conf.', 'Call to', MB_OK + MB_ICONEXCLAMATION);
        exit;
        end;

    {let user enter a host name or IP}
    s := Caption;
    i := Pos(' - ', s);
    if i>0 then s := RightStr(s, length(s) - i - 2);

    {call to it}
    if InputQuery('Call to', 'Enter remote host name or IP:', s) then CallTo(s)

end;

procedure TForm1.CallTo(Host : String);
begin
    {set the udpsocket1's default
    remote to Host}
    UDPSocket1.SetHost(Host);

    {tell remote we call him}
    UDPSocket1.Frame(-1, -1, TM_CALLSETUP, 0);

    {set timeout action to TM_CALLSETUP}
    lState := TM_CALLSETUP;
    {set timeout count}
    lCount := 10;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    {if we are in conf hangup.}
    if blnConf then Hangup()
end;

procedure TForm1.Hangup();
var
        vt: OleVariant;
begin
    {if recording in progress stop it}
    If blnRecording Then StopRecord();

    {tell remote we need hangup}
    vt := 'Remote hangup.';
    UDPSocket1.Frame(-1, -1, TM_CALLHANGUP, 0, vt);

    {clear local state}
    ClearCall();
end;


procedure TForm1.ClearCall();
begin
    {reset in conf flag}
    blnConf := False;

    {reset timeout state}