avunt.pas

絮语2007视频聊天软件源程序.仅供参考

unit avunt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,jpeg, Menus, Buttons,constunt,structureunt, ComCtrls,compress,
  IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent, IdUDPBase,
  IdUDPServer,IdSocketHandle;

type
  Tavfrm = class(TForm)
    myvideo: TImage;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    MainMenu1: TMainMenu;
    N7: TMenuItem;
    N9: TMenuItem;
    N17: TMenuItem;
    mic: TSpeedButton;
    micbar: TProgressBar;
    out: TSpeedButton;
    outbar: TProgressBar;
    N13: TMenuItem;
    UDPServer: TIdUDPServer;
    Freeze: TIdAntiFreeze;
    N5: TMenuItem;
    N6: TMenuItem;
    N2: TMenuItem;
    Timer1: TTimer;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
    procedure micClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure UDPServerUDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure N13Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    videocount:smallint;
    just_talking,allowaudio,allowvideo,
    showmyvideo,acceptisok,succeedconnect:boolean;
    procedure initavfrom;
    procedure showfirendinfo;
    procedure sendmsgto(msg:string);
    procedure handshake(msgid:integer);
    procedure sendaudio;
    procedure playaudio(params:string);
    procedure sendvideo;
    procedure playvideo(params:string);
    procedure process_custom_message(var msg:tmessage);message refresh_status;
    { Private declarations }
  public
    Fserver:boolean;
    firendid:string;
    svrip,destip:string;
    svrport,destport:integer;
    procedure sendmsgtosvr(msg:string);
    { Public declarations }
  end;

implementation
uses udpcores,shareunit,trackunt;
{$R *.DFM}

//------------------------------------------------------------------------------
// 窗体事件
//------------------------------------------------------------------------------
procedure Tavfrm.CreateParams(var Params: TCreateParams);
begin
  inherited ;
  Params.WndParent := 0;
end;

procedure Tavfrm.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
if newheight<210 then newheight:=210;
if newwidth<168  then newwidth:=168;
end;

procedure Tavfrm.FormCreate(Sender: TObject);
var picfile:string;
begin
addhwnd(handle);
udpcore.changeLayered(handle);
initavfrom;
picfile:=udpcore.pic.getmd5tofile(videopic);
if fileexists(picfile) then
  try
  myvideo.Picture.LoadFromFile(picfile);
  except
    on EInvalidGraphic do
       myvideo.Picture:= nil;
  end;
end;

procedure Tavfrm.showfirendinfo;
var tmpinfo:userinfo;
begin
if udpcore.user.checkuser(firendid) then
   begin
   tmpinfo:=udpcore.user.getuserinfoex(firendid);
   caption:=tmpinfo.uname;
   statusbar1.Panels.Items[0].Text:='IP:'+destip;
   end;
end;

procedure Tavfrm.FormShow(Sender: TObject);
begin
if Fserver then N13.Caption:='挂断'
   else begin
   succeedconnect:=true;
   handshake(xy_succeed_handshake);
   showfirendinfo;
   end;
end;

//------------------------------------------------------------------------------
//  弹出音量设置
//------------------------------------------------------------------------------
procedure Tavfrm.micClick(Sender: TObject);
var mouse:tpoint;
begin
GetCursorPos(mouse);
with trackfrm do
  begin
  left:=mouse.x;
  top:=mouse.y;
  waveaudio:=sender=out;
  show;
  end;
end;

//------------------------------------------------------------------------------
//  自定义消息
//------------------------------------------------------------------------------
procedure Tavfrm.process_custom_message(var msg:tmessage);
begin
case msg.WParam of
  xy_form_close:close;
  xy_media_complete:close;
  xy_media_outtime:;
  xy_refuseing:udpcore.showmsgfrm('对方拒绝了您的视频!');
  xy_media_audio:sendaudio;
  xy_media_video:sendvideo;
  end;
end;

//------------------------------------------------------------------------------
//  声音发送
//------------------------------------------------------------------------------
procedure Tavfrm.sendaudio;
var datastr:string;
begin
datastr:=udpcore.audio_dx9.avdata;
if length(datastr)>0 then
if just_talking and allowaudio then
   begin
   micbar.Position:=getmaxvol(datastr);
   sendmsgto(concat(makepacket(xy_audio,0,0),datastr));
   end;
end;

//------------------------------------------------------------------------------
//  声音播放
//------------------------------------------------------------------------------
procedure Tavfrm.playaudio(params:string);
begin
outbar.Position:=getmaxvol(params);
udpcore.audio_dx9.playwave(params);
end;

//------------------------------------------------------------------------------
//  发送视频
//------------------------------------------------------------------------------
procedure Tavfrm.sendvideo;
var datastr:string;
    tmpstream:tmemorystream;
begin
if showmyvideo then
   begin
   myvideo.Picture.bitmap.Assign(udpcore.video_dx9.outbitmap);
   myvideo.Invalidate;
   end else begin
    try
    tmpstream:=tmemorystream.create;
    if just_talking and allowvideo then
       begin
        with tjpegimage.Create do
          try
          assign(udpcore.video_dx9.outbitmap);
          Compress;
          SaveToStream(tmpstream);
          finally
          free;
          end;
        setlength(datastr,tmpstream.size);
        tmpstream.Seek(0,soFromBeginning);
        tmpstream.readbuffer(datastr[1],tmpstream.size);
        sendmsgto(concat(makepacket(xy_video,0,0),datastr));
       end;
    finally
    freeandnil(tmpstream);
    end;
   end;
end;

//------------------------------------------------------------------------------
//  播放视频
//------------------------------------------------------------------------------
procedure Tavfrm.playvideo(params:string);
var tmpstream:tmemorystream;
begin
try
tmpstream:=Tmemorystream.Create;
tmpstream.WriteBuffer(params[1],length(params));
tmpstream.Seek(0,soFromBeginning);
if not showmyvideo then
  try
     myvideo.Picture.Graphic.LoadFromStream(tmpstream);
  except
  on EInvalidGraphic do
     myvideo.Picture.Graphic := nil;
  end;
finally
inc(videocount);
freeandnil(tmpstream);
end;
end;

//------------------------------------------------------------------------------
//  退出
//------------------------------------------------------------------------------
procedure Tavfrm.N13Click(Sender: TObject);
begin
if not just_talking then
   begin
   if Fserver then close
      else begin
      N13.caption:='挂断';
      just_talking:=true;
      acceptisok:=true;
      handshake(xy_starting);//确认连接
      end;
   end else close;
end;

//------------------------------------------------------------------------------
//  初始化窗口
//------------------------------------------------------------------------------
procedure Tavfrm.initavfrom;
begin
udpserver.Bindings.clear;
with udpserver.Bindings.add do
  begin
  ip:='0.0.0.0';
  port:=0;
  end;
udpserver.Active:=true;
udpserver.Binding.UpdateBindingLocal;
allowvideo:=true;
allowaudio:=true;
udpcore.video_dx9.videostart;
end;

procedure Tavfrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
delhwnd(handle);
just_talking:=false;
udpcore.video_dx9.videostop;
if not acceptisok then
   begin
   if Fserver then handshake(xy_cancel) else handshake(xy_refuseing);
   end else handshake(xy_cancel);
udpserver.Active:=false;
action:=cafree;
Tavfrm(sender):=nil;
end;

//------------------------------------------------------------------------------
//  消息发送
//------------------------------------------------------------------------------
procedure Tavfrm.sendmsgto(msg:string);
begin
if succeedconnect then
udpserver.Binding.SendTo(destip,destport,msg[1],length(msg));
sleep(1);
end;

//------------------------------------------------------------------------------
// 简单命令交互
//------------------------------------------------------------------------------
procedure Tavfrm.handshake(msgid:integer);
begin
sendmsgto(makepacket(msgid,0,0));
end;

//------------------------------------------------------------------------------
// 与中转服务器进行协商
//------------------------------------------------------------------------------
procedure Tavfrm.sendmsgtosvr(msg:string);
begin
makeparamsex(msg,'language',locallanguage);
encompress(msg);//压缩
udpserver.Binding.SendTo(svrip,svrport,msg[1],length(msg));
sleep(1);
end;

procedure Tavfrm.UDPServerUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var datastr:string;
    tmpack:Tdatapack;
begin
try
adata.Seek(0,soFromBeginning);
setlength(datastr,adata.size-sizeof(Tdatapack));
adata.ReadBuffer(tmpack,sizeof(Tdatapack)); //取出msgid 和 position
adata.ReadBuffer(datastr[1],adata.size-sizeof(Tdatapack)); //取出 msgtext

case tmpack.msgid of
  xy_succeed_handshake:
     begin
     destip:=ABinding.PeerIP;
     destport:=ABinding.PeerPort;
     succeedconnect:=true;
     showfirendinfo;
     end;

  xy_starting:
     begin
     just_talking:=true;
     acceptisok:=true;
     end;
     
  xy_audio:
     begin
     playaudio(datastr);
     end;

  xy_video:
     begin
     playvideo(datastr);
     end;

  xy_cancel:
     begin
     just_talking:=false;
     postmessage(handle,refresh_status,xy_media_complete,0);
     end;

  xy_refuseing:
     begin
     //对方拒绝
     postmessage(handle,refresh_status,xy_refuseing,0);
     postmessage(handle,refresh_status,xy_media_complete,0);
     end;
     
  end;

except
logmemo.Add('Error:'+datastr);
end;
end;

procedure Tavfrm.N16Click(Sender: TObject);
begin
n5.checked:=not n5.Checked;
allowvideo:=not n5.checked;
end;

procedure Tavfrm.N9Click(Sender: TObject);
begin
udpcore.video_dx9.videoseting(handle);
end;

procedure Tavfrm.N6Click(Sender: TObject);
begin
n6.checked:=not n6.Checked;
showmyvideo:=n6.checked;
end;

procedure Tavfrm.N2Click(Sender: TObject);
begin
n2.checked:=not n2.Checked;
allowaudio:=not n2.checked;
end;

procedure Tavfrm.Timer1Timer(Sender: TObject);
var nn:integer;
begin
nn:=videocount;
videocount:=0;
if nn>0 then statusbar1.Panels.items[1].text:=inttostr(nn)+'帧/S';
end;

end.