unit1.~pas

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

    lState := 0;

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

procedure TForm1.Timer1Timer(Sender: TObject);
var
        l : integer;
        s : String;
begin
    {decrease timeout count}
    if lCount > 0 then
        lCount := lCount - 1

    else
    begin
        {clear timeout state}
        l := lState;
        lState := 0;

        {check state and decide what will be do}
        Case l of
        TM_CALLSETUP:
            {timeout while call setup
            nothing to do, just show a message}
            s := 'Remote not response.';

        TM_CALLANSWER:
        begin
            {timout while call has been setup,
            need clear it}
            Hangup();

            s := 'Communication timeout.';
            end;
        end;

        if length(s)>0 then Application.MessageBox(pchar(s), 'Timeout', MB_OK + MB_ICONEXCLAMATION)
    end;
end;

procedure TForm1.UDPSocket1Frame(Sender: TObject; Address: Integer; Port: Smallint;
  Handle, Param: Integer; var Data: OleVariant);
var
        vt : OleVariant;
        s : string;
begin
try
    Case Handle of
    TM_CALLSETUP:
        if blnConf then
        begin
            {if we already in a conf, reject it.}
            vt := 'Remote already in a conf';
            UDPSocket1.Frame(Address, Port, TM_CALLREJECT, 0, vt);
            end
        else
        begin

        s := 'Call from: ' + UDPSocket1.GetIP(Address) + ', accept?';
        If Application.MessageBox(pchar(s), 'Call coming', MB_YESNO + MB_ICONQUESTION) = IDYES then
        begin
            {accept it}
            UDPSocket1.Frame(Address, Port, TM_CALLANSWER, 0);

            {establish it}
            EstablishCall(Address, Port);
            end

        else
        begin
            {reject with the reason}
            vt := 'Remote reject your call.';
            UDPSocket1.Frame(Address, Port, TM_CALLREJECT, 0, vt);
            end
        end;

    TM_CALLANSWER:
        {if we are not in a conf establish it}
        If Not blnConf then EstablishCall(Address, Port);

    TM_CALLREJECT:
        {if we are not in a conf reset timeout state
        and show the reason}
        if blnConf = False Then
        begin
            lState := 0;
            s := Data;
            Application.MessageBox(pchar(s), 'Call rejected', MB_OK + MB_ICONEXCLAMATION);
            end;
    else

        {all of the other messages except call setup related
        are only valid when a conf already established}
        If not blnConf then exit;

        {remote still link with us
        reset timeout count}
        lCount := 30;

        Case Handle of
        TM_CALLHANGUP:
        begin
            {if recording in progress stop it}
            If blnRecording Then StopRecord();

            {remote hangup
            clear the call}
            ClearCall();

            s := Data;
            Application.MessageBox(pchar(s), 'Hangup', MB_OK + MB_ICONEXCLAMATION);
            end;
        TM_AUDIOFORMAT:
        begin

            {new audio format need to be rendered

            stop old format rendering}
            AudCodec2.OutFormat := '';

            {set new format which will be decompressed}
            AudCodec2.InFormat := Data;

            {start new format rendering}
            AudRnd1.Format := AudCodec2.OutFormat;
            end;

        TM_AUDIOFRAME:
        begin
            {if recording in progress write it to avi file}
            If blnRecording Then AVIFile1.StreamWrite(-1, Data, True);

            {audio frames arrivaled
            write to decompressor}
            AudCodec2.Frame(Data);
            end;
        TM_VIDEOFORMAT:
        begin
            {new video format need to be rendered

            stop old format rendering}
            VidCodec2.OutFormat := '';

            {set new format which will be decompressed}
            VidCodec2.InFormat := Data;

            {start new format rendering}
            VidRnd1.Format := VidCodec2.OutFormat

            end;

        TM_VIDEOFRAME:
        begin

            {if recording in progress write it to avi file}
            If blnRecording Then AVIFile1.StreamWrite(-2, Data, False);

            {video normal frame arrivaled
            write to decompressor with key indication false}
            VidCodec2.Frame(Data, False);
            end;

        TM_VIDEOFRAMEKEY:
        begin
            {if recording in progress write it to avi file}
            If blnRecording Then AVIFile1.StreamWrite(-2, Data);

            {video key frame arrivaled
            write to decompressor with key indication true}
            VidCodec2.Frame(Data, True);
            end;

        TM_VIDEORATE:
            {remote video speed}
            VidRnd1.Rate := Data;

        end;
    end;
except
end;
end;

procedure TForm1.EstablishCall(Addr : integer; Port : Smallint);
var
        vt : OleVariant;
begin
    {set in conf flag}
    blnConf := True;

    {set timeout state to connected}
    lState := TM_CALLANSWER;

    {set timeout count to 30 seconds}
    lCount := 30;

    {set default remote address}
    UDPSocket1.SetHost(Addr);
    {set default remote port}
    UDPSocket1.SetPort(Port);

    {tell remote our compressed audio and video format and speed}
    vt := AudCodec1.OutFormat;
    UDPSocket1.Frame(-1, -1, TM_AUDIOFORMAT, 0, vt);
    vt := VidCodec1.OutFormat;
    UDPSocket1.Frame(-1, -1, TM_VIDEOFORMAT, 0, vt);
    vt := VidCap1.Rate;
    UDPSocket1.Frame(-1, -1, TM_VIDEORATE, 0, vt);
end;

procedure TForm1.VidCodec2Frame(Sender: TObject; var Data: OleVariant;
  IsKeyFrame: WordBool);
begin
try
    {video frame decompressed
    write to vidrnd control to render it}
    VidRnd1.Frame(Data, True);
except
end;
end;

procedure TForm1.AudCodec2Frame(Sender: TObject; var Data: OleVariant);
begin
try
    {audio frames decompressed
    write to audrnd control to render it}
    AudRnd1.Frame(Data);
except
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    {release call before exiting}
    If blnConf then Hangup();

    {if recording is still in progress stop it}
    If blnRecording Then StopRecord();

    {stop all}
    AudCap1.Device := -2;
    VidCap1.Device := -2;

    AudCodec1.OutFormat := '';
    AudCodec2.OutFormat := '';
    VidCodec1.OutFormat := '';
    VidCodec2.OutFormat := '';

    AudRnd1.Format := '';
    VidRnd1.Format := '';

    UDPSocket1.Bind(0);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
        s : string;
        spath : String;
        i : Integer;

begin
    If blnRecording Then
        StopRecord()

    else
        begin
        {record to app path\capture.avi}

        s := Application.ExeName;

        i := LastDelimiter('\', s);
        Delete(s, i+1, Length(s)-i);
        spath := s + 'capture.avi';

        {press OK to start}
        if blnConf then
                s := 'remote'
        else
                s := 'local';

        s := 'Press OK to capture ' + s + ' audio/video to file ' + spath;
        if(Application.MessageBox(pchar(s), 'Recording', MB_OKCANCEL + MB_ICONQUESTION)<>IDOK) then exit;

        {if file exists ask for deleting}
        if(FileExists(spath)) then
        begin
            s := spath + ' exists, overwrite?';
            if(Application.MessageBox(pchar(s), 'Confirm', MB_YESNO + MB_ICONEXCLAMATION)<>IDYES) then exit;

            DeleteFile(spath);
            end;

        StartRecord(spath);

    end;
end;

procedure TForm1.StopRecord();
begin
    {clear the flag}
    blnRecording := False;

    {close avi file}
    AVIFile1.CloseFile();

    {reset button caption}
    Button3.Caption := 'Rec&ord';
end;

procedure TForm1.StartRecord(Path : string);
var
    vt : OleVariant;
    s : WideString;
    d : double;

begin
    {recording avi to the capture.avi file}
    s := Path;
    AVIFile1.OpenFile(s, False, '');

    {if we are in conf we record the remote
    audio/video otherwise record the local
    audio/video}
    if blnConf then
        vt := AudCodec2.InFormat
    else
        vt := AudCodec1.OutFormat;
    s := vt;
    if(Length(s) > 0) then
    begin
        {add default audio track}
        vt := Variant(-1);
        AVIFile1.StreamAdd(vt);

        {set it's format}
        AVIFile1.StreamFormat[-1] := s;
    end;

    {for video}
    if blnConf then
        vt := VidCodec2.InFormat
    else
        vt := VidCodec1.OutFormat;
    s := vt;
    if Length(s) > 0 then
    begin

        {add default video track}
        vt := Variant(-2);
        AVIFile1.StreamAdd(vt);

        d := VidRnd1.Rate;
        if(d < 0) then d := -d;

        AVIFile1.StreamRate[-2] := d;
        AVIFile1.StreamFormat[-2] := s;
    end;

    {set recording flag}
    blnRecording := True;

    {set button caption}
    Button3.Caption := 'St&op';
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
    //connect to audio driver by name
    ConnectAudio(ListBox1.Items.Strings[ListBox1.ItemIndex]);
end;

end.