udpcores.pas

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

procedure tudpcore.sendtomessager(firendid,params:string);
var tmp,myinfo:userinfo;
    msg:string;
begin
if user.checkuser(firendid) then
   begin
   tmp:=user.getuserinfoex(firendid);
   myinfo:=user.getuserinfoex(0);
   msg:=tmp.uname+':'+#13#10+'  ';
   msg:=msg+getparamitem(params,'msgtext')+#13#10;
   msg:=msg+myinfo.uname;
   winexec(pchar('net send '+tmp.localip+' '+msg),0);
   end;
end;

//------------------------------------------------------------------------------
// 搜索指定网段内的用户
//------------------------------------------------------------------------------
procedure tudpcore.finderuser(ip:string);
var i:integer;
    tmp:userinfo;
    iphead,msg:string;
begin
tmp:=user.getuserinfoex(0);
makeparamsex(msg,'msgid',xy_user);
makeparamsex(msg,'funid',xy_search);
makeparamsex(msg,'operation',xy_finder);
makeparamsex(msg,'md5name',tmp.md5name);
if checkip(ip) then
  begin
  iphead:=getipheard(ip);
  for i:=1 to 254 do
    begin
    sendtoip(iphead+inttostr(i),msg);
    application.ProcessMessages;
    end;
  end else sendbroadcast(msg);
end;

//------------------------------------------------------------------------------
// 查询好友是否在线..
//------------------------------------------------------------------------------
procedure Tudpcore.query_firend_status(v:integer);
var i:integer;tmp,myinfo:userinfo;
    msg:string;
begin
myinfo:=user.getuserinfoex(0);
makeparamsex(msg,'msgid',xy_user);
makeparamsex(msg,'funid',xy_status);
makeparamsex(msg,'md5name',myinfo.md5name);
if v=0 then
   begin
   makeparamsex(msg,'operation',xy_login);
   makeparamsex(msg,'status',myinfo.status);
   end;

if (v=1) or (v=2) then
   begin
   makeparamsex(msg,'operation',xy_responses);
   makeparamsex(msg,'status',myinfo.status);
   end;

if v=3 then
   begin
   makeparamsex(msg,'operation',xy_logout);
   makeparamsex(msg,'status',3);
   end;
   
if user.getcount>0 then
for i:=user.getcount downto 2 do
  begin
  tmp:=user.getuserinfoex(i-1);
  if (not tmp.nullity)and(checkip(tmp.localip)) then
     begin
     if v=0 then
       begin
       tmp.status:=3;
       user.modifyuser(i,tmp);
       end;
     if (v>0)and (tmp.status=3) then Continue;
     sendtoip(tmp.localip,msg);
     application.ProcessMessages;
     end;
  end;
end;

//------------------------------------------------------------------------------
// 通讯处理过程
//------------------------------------------------------------------------------
procedure Tudpcore.udpmsgUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var datastr,funid,fromip:string;
    fromport:integer;
    xy_model:tmodel;
begin
fromip:=abinding.PeerIP;
fromport:=abinding.PeerPort;
try
adata.Seek(0,soFromBeginning);
setlength(datastr,adata.size);
adata.ReadBuffer(datastr[1],adata.size);
uncompress(datastr); //解压
languageconversion(datastr); //转换语言
if length(datastr)>10 then
  try
  makeparamsex(datastr,'fromip',fromip);
  makeparamsex(datastr,'fromport',fromport);
  funid:=getparamitem(datastr,'msgid');
  case strtointdef(funid,xy_unknow) of
    xy_user:        xy_model:=Tusermodel.create;
    xy_message:     xy_model:=Tmessagemodel.create;
    xy_game:        xy_model:=tgamemodel.create;
    xy_downpic:     xy_model:=Tdownpicmodel.create;
    xy_file:        xy_model:=Tfilemodel.create;
    xy_media:       xy_model:=Tmediamodel.create;
    xy_remote:      xy_model:=Tremotemodel.create;
    xy_unknow:logmemo.add('unknow:'+datastr);
    end;

  finally
  if assigned(xy_model) then
     begin
     xy_model.process(datastr);
     freeandnil(xy_model);
     end;
  end;

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

//------------------------------------------------------------------------------
// 系统热键处理
//------------------------------------------------------------------------------
procedure Tudpcore.reghotkey(s1:string;s2:integer);
var items:thotkeyitem;
 function inttochar(n:integer):char;
  begin
  result:=chr(n-16384);
  end;
begin
if s2>32858 then   // ctrl+alt
  begin
  items.VirtKey:=syshotkey.keytovirtkeys(inttochar(s2-32768));
  items.Modifiers:=[HKCTRL,HKALT];
  end else
if s2>16474 then  //alt
  begin
  items.VirtKey:=syshotkey.keytovirtkeys(inttochar(s2-16384));
  items.Modifiers:=[HKALT];
  end else
if s2>16384 then  //ctrl
  begin
  items.VirtKey:=syshotkey.keytovirtkeys(inttochar(s2));
  items.Modifiers:=[HKCTRL];
  end else
if s2<16384 then // none
   begin
   items.VirtKey:=syshotkey.keytovirtkeys(inttochar(s2+16384));
   items.Modifiers:=[];
   end;
items.hintstring:=s1;
syshotkey.add(items);
end;

procedure Tudpcore.recreate_hotkey;
begin
syshotkey.Clear;
reghotkey('systemhot_key',systemhot_key); //系统呼出 hotkey
reghotkey('bosshot_key',bosshot_key);  //截取屏幕 hotkey
end;

procedure Tudpcore.SysHotKeyHotKey(Sender: TObject; Index: Integer);
var s:string;
begin
s:=tSysHotKey(sender).get(index).hintstring;
if s='bosshot_key' then
   postmessage(main_hwnd,refresh_status,xy_boss_form,0);
if s='systemhot_key' then
   postmessage(main_hwnd,refresh_status,xy_showmainfrm,0);
end;

//------------------------------------------------------------------------------
// 处理定时计划任务
//------------------------------------------------------------------------------
procedure Tudpcore.process_tasklist(Tmp:ttaskinfo);
var tmpuser:userinfo;
    tmptxt:string;
begin
if udpcore.user.checkuser(Tmp.firendid) then
    begin
    tmpuser:=user.getuserinfoex(Tmp.firendid);
    if tmpuser.status<>3 then
       begin
       tmp.nullity:=true;
       task.modifytask(tmp.md5code,tmp);
       tmptxt:=strpas(tmp.msgtext);
       if tmp.tasktype then //处理文件发送
         begin
         createfiletranfrom(tmp.firendid,
         getparamitem(tmptxt,'filelist'),getparamitem(tmptxt,'sourcepath'));
         end else begin   //处理文本消息
         sendtouser(tmp.firendid,tmptxt);
         end;
       end;
     end else begin            //用户不存在了.删除
     tmp.nullity:=true;
     task.modifytask(tmp.md5code,tmp);
     end;
end;

procedure Tudpcore.createtaskmainfrm;
begin
with Ttaskmainfrm.create(application) do
  try
  showmodal;
  finally
  free;
  end;
end;


//------------------------------------------------------------------------------
// 发送多个文件
//------------------------------------------------------------------------------
procedure Tudpcore.sendmutilfile(userlist:string);
begin
with topendialog.create(nil) do
  try
  Title:='选择要发送的文件.';
  Filter:='所有文件(*.*)|*.*';
  Options:=[ofFileMustExist,ofAllowMultiSelect];
  if execute then
     sendfileprocess(userlist,files.text,extractfilepath(files.strings[0]));
  finally
  free;
  end;
end;

//------------------------------------------------------------------------------
// 发送目录
//------------------------------------------------------------------------------
procedure Tudpcore.senddirectory(userlist:string);
var path:string;
    tmplist:tstringlist;
begin
try
tmplist:=tstringlist.create;
if selectpath(path) then
   begin
   FindFile(path+'*.*',tmplist,true);
   path:=fixdirectory(path);
   if tmplist.Count>0 then
      sendfileprocess(userlist,tmplist.text,path);
   end;
finally
freeandnil(tmplist);
end;
end;

procedure Tudpcore.sendfileprocess(userlist,filelist,srcpath:string);
var i:integer;
    tmplist:tstringlist;
begin
try
tmplist:=tstringlist.create;
tmplist.Text:=userlist;
if tmplist.Count>0 then
for i:=1 to tmplist.count do
  createfiletranfrom(tmplist.strings[i-1],filelist,srcpath);
finally
freeandnil(tmplist);
end;
end;
//------------------------------------------------------------------------------
// 创建新的文件传输
//------------------------------------------------------------------------------
procedure Tudpcore.createfiletranfrom(firendid,filelist,srcpath:string);
var filetranfrm:Tfiletranfrm;
    tmpinfor,myinfo:userinfo;
    msgex:string;
begin
filelist:=fixfilelistpath(srcpath,filelist);
if user.checkuser(firendid) then
   begin
   myinfo:=user.getuserinfoex(0);
   tmpinfor:=user.getuserinfoex(firendid);
   if tmpinfor.status<>3 then
       begin
       filetranfrm:=Tfiletranfrm.create(application);
       filetranfrm.Edit1.text:=tmpinfor.uname;
       filetranfrm.svrip:=tmpinfor.localip;
       filetranfrm.source_path:=srcpath;
       filetranfrm.filelist.Text:=filelist;
       filetranfrm.svrport:=core_port;
       filetranfrm.Fserver:=true;
       filetranfrm.initfiletran;
       filetranfrm.Show;
       makeparamsex(msgex,'msgid',xy_file);
       makeparamsex(msgex,'funid',xy_request);
       makeparamsex(msgex,'firendid',myinfo.md5name);
       filetranfrm.sendmsgtosvr(msgex);
       end else begin  //放入任务队列中.
       makeparamsex(msgex,'sourcepath',srcpath);
       makeparamsex(msgex,'filelist',filelist);
       showmsgfrm('用户: '+tmpinfor.uname+' 不在线.您的请求将被添加进定时序列.');
       if length(filelist)>1968 then showmsgfrm('您选择了太多的文件定时序列任务将被取消.')
          else udpcore.task.addtask(nowtimedefer(15),firendid,msgex,true);
       end;
   end;
end;

//------------------------------------------------------------------------------
//  开始接收文件
//------------------------------------------------------------------------------
procedure Tudpcore.createfiletranfrom(params:string);
var filetranfrm:Tfiletranfrm;
    tmpinfor:userinfo;
    firendid:string;
begin
firendid:=getparamitem(params,'firendid');
if user.checkuser(firendid) then
   begin
   tmpinfor:=user.getuserinfoex(firendid);
   filetranfrm:=Tfiletranfrm.create(application);
   filetranfrm.Edit1.text:=tmpinfor.uname;
   filetranfrm.svrip:=tmpinfor.localip;
   filetranfrm.svrport:=core_port;
   filetranfrm.dest_path:=autopath;
   filetranfrm.destip:=getparamitem(params,'fromip');
   filetranfrm.destport:=strtoint(getparamitem(params,'fromport'));
   filetranfrm.Fserver:=false;
   filetranfrm.initfiletran;
   filetranfrm.Show;
   end;
end;

//------------------------------------------------------------------------------
//  检查是否有文件传输请求
//------------------------------------------------------------------------------
procedure Tudpcore.checkfiletran;
var i:integer;
    params:string;
begin
if expandmemo.count>0 then
for i:=1 to expandmemo.count do
  begin
  params:=expandmemo.strings[i-1];
  if getparamitem(params,'msgid')=inttostr(xy_file) then
  if getparamitem(params,'funid')=inttostr(xy_request) then
     begin
     expandmemo.Delete(i-1);
     createfiletranfrom(params);
     end;
  end;

end;

//------------------------------------------------------------------------------
//  语音视频
//------------------------------------------------------------------------------
procedure Tudpcore.createavfrom(firendid:string);
var avfrm:Tavfrm;
    tmpinfor,myinfo:userinfo;
    msgex:string;
begin
if udpcore.user.checkuser(firendid) then
   begin
   myinfo:=user.getuserinfoex(0);
   tmpinfor:=user.getuserinfoex(firendid);
   avfrm:=tavfrm.create(application);
   avfrm.firendid:=firendid;
   avfrm.svrip:=tmpinfor.localip;
   avfrm.svrport:=core_port;
   avfrm.Fserver:=true;
   avfrm.show;
   makeparamsex(msgex,'msgid',xy_media);
   makeparamsex(msgex,'funid',xy_request);
   makeparamsex(msgex,'firendid',myinfo.md5name);
   avfrm.sendmsgtosvr(msgex);
   end;
end;

procedure Tudpcore.createavfromex(params:string);
var avfrm:Tavfrm;
    tmpinfor:userinfo;
    firendid:string;
begin
firendid:=getparamitem(params,'firendid');
if udpcore.user.checkuser(firendid) then
   begin
   tmpinfor:=user.getuserinfoex(firendid);
   avfrm:=tavfrm.create(application);
   avfrm.firendid:=firendid;
   avfrm.svrip:=tmpinfor.localip;
   avfrm.svrport:=core_port;
   avfrm.destip:=getparamitem(params,'fromip');
   avfrm.destport:=strtoint(getparamitem(params,'fromport'));
   avfrm.Fserver:=false;
   avfrm.show;
   end;
end;

procedure Tudpcore.checkmedia;
var i:integer;
    params:string;
begin
if expandmemo.count>0 then
for i:=1 to expandmemo.count do
  begin
  params:=expandmemo.strings[i-1];
  if getparamitem(params,'msgid')=inttostr(xy_media) then
  if getparamitem(params,'funid')=inttostr(xy_request) then
     begin
     expandmemo.Delete(i-1);
     createavfromex(params);
     end;
  end;
end;

//------------------------------------------------------------------------------
//  远程协助
//------------------------------------------------------------------------------
procedure Tudpcore.createremotesvrfrm(firendid:String);
var myinfo,tmpinfor:userinfo;
begin
if user.checkuser(firendid) then
   begin
   myinfo:=user.getuserinfoex(0);
   tmpinfor:=user.getuserinfoex(firendid);
   if not remotesvrfrm.Showing then
      begin
       remotesvrfrm.firendid:=firendid;
       remotesvrfrm.svrip:=tmpinfor.localip;
       remotesvrfrm.svrport:=core_port;
       remotesvrfrm.show;
      end;
   end;
end;

procedure Tudpcore.createremotesvrfrmex(params:String);
var remotecltfrm:Tremotecltfrm;
    tmpinfor:userinfo;
    firendid:string;
begin
firendid:=getparamitem(params,'md5name');
if udpcore.user.checkuser(firendid) then
   begin
   tmpinfor:=user.getuserinfoex(firendid);
   remotecltfrm:=Tremotecltfrm.create(application);
   remotecltfrm.firendid:=firendid;
   remotecltfrm.svrip:=tmpinfor.localip;
   remotecltfrm.svrport:=core_port;
   remotecltfrm.destip:=getparamitem(params,'fromip');
   remotecltfrm.destport:=strtoint(getparamitem(params,'fromport'));
   remotecltfrm.show;
   end;
end;

procedure Tudpcore.checkremote;
var i:integer;
    params:string;
begin
if expandmemo.count>0 then
for i:=expandmemo.count downto 1 do
  begin
  params:=expandmemo.strings[i-1];
  if getparamitem(params,'msgid')=inttostr(xy_remote) then
  if getparamitem(params,'funid')=inttostr(xy_request) then
     begin
     expandmemo.Delete(i-1);
     showprompt('远程协助',params);
     end;
  end;
end;

end.