un_main.pas

局域网的一个聊天程序

unit Un_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, RzTray, Menus, ScktComp, ExtCtrls, ImgList,
  IdBaseComponent, IdComponent, IdTCPServer, IdCustomHTTPServer,HTTPApp,
  IdHTTPServer, HTTPProd,Sockets, IdThreadMgr, IdThreadMgrDefault,
  Grids, ValEdit, ExtDlgs, IdGlobal,inifiles, IdUDPBase, IdUDPServer,IdSocketHandle,registry,
  MPlayer, IdIPWatch;
type
  Tbuf_char=array[0..8191] of char;
  Tbuf_byte=array[0..8191] of byte;



type

  Tfilebuf=record
    pos:integer;
    size:integer;
    buf:Tbuf_byte;
    end;

  Tform_main = class(TForm)
    RzTrayIcon1: TRzTrayIcon;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    ss_file: TServerSocket;
    Timer1: TTimer;
    ImageList1: TImageList;
    tim_flasicon: TTimer;
    idhtp: TIdHTTPServer;
    pp_chat_main: TPageProducer;
    pp_chat_script: TPageProducer;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    tim_writemsg: TTimer;
    op_file: TOpenDialog;
    N4: TMenuItem;
    sv_file: TSaveDialog;
    N5: TMenuItem;
    idudp: TIdUDPServer;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    mp_msg: TMediaPlayer;
    IdIP: TIdIPWatch;
    procedure N1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure tim_flasiconTimer(Sender: TObject);
    procedure idhtpCommandGet(AThread: TIdPeerThread;
      ARequestInfo: TIdHTTPRequestInfo;
      AResponseInfo: TIdHTTPResponseInfo);
    procedure tim_writemsgTimer(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure idudpUDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure op_fileCanClose(Sender: TObject; var CanClose: Boolean);
  private

  public
   msghide:string;          //在聊天窗体为隐藏的情况下保存接收到的文件信息
   msg:string;              //发送的消息
   pc_name:string;          //本地计算机名
   user_name:string;         //用户名
   user_part:string;         //聊天组名
   writingmsg:bool;          //写消息的状态
   cfg:Tinifile;
   alwdownfilelist:Tstrings;   //允许网络上的用户访问的文件列表
   conntimeout:integer;        //连接超时时间
   runonboot:boolean;          //是否在开机时自动运行
   offresponse:string;         //离线回复的消息内容
   msgsoundfilename:string;    //收到消息的声音
   alwplaysound:bool;             //是允许否播放声音
   udpbusy:bool;                  //udp服务是否在工作
   ipsect:string;
   procedure addto_alwdownfilelist(filename:string);   //将文名添加到允许访问列表
   function get_user_infostring(username:string;userpart:string;pcname:string;pcip:string):string; //编排并返回用户的信息
   procedure updatecfg();  //将配置信息写入配置文件
   procedure readdatecfg();  //读取配置文件中的配置信息
   function extracipsect(ip:string):string; //根据分析一个ip地址的网段
   procedure writemsg(msg:String);           //写消息到聊天栏
   procedure writemsgintime(msg: String);    //定时写消息到聊天拦
   procedure responsestatus(ip:string);       //根据当前用户状态返回用户离开的消息
   procedure setrunonbootreg(run:bool);       //将开机自动运行的信息写入注册表或从注册表中删除
   function getsystemroot:string;              //取得当前操作系统的根目录
   procedure playsound(sound:string);          //播放声音
  end;

var
  form_main: Tform_main;
  var hnd: THandle;
implementation


uses Un_chart, Un_config;

{$R *.dfm}

procedure Tform_main.N1Click(Sender: TObject);
begin
if not form_chat.msgall.Busy then
 begin
  if not form_chat.Visible then
   form_chat.Show;
  if form_chat.WindowState=wsMinimized then
   form_chat.WindowState:=wsnormal;
  form_chat.mm_msginput.SetFocus;
  form_main.writemsgintime(form_main.msghide);
  form_main.msghide:='';
 end;
end;

procedure Tform_main.N3Click(Sender: TObject);
begin
close;
end;

procedure Tform_main.Timer1Timer(Sender: TObject);
begin
 timer1.Enabled:=false;
 form_chat.Close;
end;

procedure Tform_main.tim_flasiconTimer(Sender: TObject);
begin
if RzTrayIcon1.IconIndex=1 then
 RzTrayIcon1.IconIndex:=0
else
 RzTrayIcon1.IconIndex:=1;
end;

procedure Tform_main.idhtpCommandGet(AThread: TIdPeerThread;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
filename:string;
begin

 if copy(arequestinfo.Document,0,6)='/file/' then
  begin
   filename:=httpdecode(ARequestInfo.QueryParams);
   if fileexists(filename) and (pos(filename,alwdownfilelist.Text)<>0) then
    begin
     aresponseinfo.ContentType:='file';
     idhtp.ServeFile(Athread,Aresponseinfo,httpdecode(ARequestInfo.QueryParams));
    end
   else
    Aresponseinfo.ResponseNo:=404;
  end
 else if copy(arequestinfo.Document,0,9)='/udpfile/' then
  begin
   aresponseinfo.ContentText:='111';
  end
 else if arequestinfo.Document='/chat_main' then
  begin
   aresponseinfo.ContentText:=pp_chat_main.Content;
  end
 else if arequestinfo.Document='/chat_script' then
  begin
   aresponseinfo.ContentText:=pp_chat_script.Content;
  end
 else
  Aresponseinfo.Redirect('http://www.iamy.net');  
end;

procedure Tform_main.tim_writemsgTimer(Sender: TObject);
begin
   tim_writemsg.Enabled:=false;
   try
   form_chat.writemsgall(form_main.msg);
   form_main.msg:='';
   except
   end;
   form_main.writingmsg:=false;
end;

procedure Tform_main.N4Click(Sender: TObject);
begin
if not form_chat.msgall.Busy then
 begin
 form_chat.showwelcom;
 form_chat.show;
 form_chat.SetFocus;
 if form_chat.WindowState=wsMinimized then
  form_chat.WindowState:=wsnormal;
 end; 
end;

procedure Tform_main.addto_alwdownfilelist(filename: string);
begin
 if pos(filename,alwdownfilelist.Text)=0 then
  alwdownfilelist.Add(filename); 
end;

function Tform_main.get_user_infostring(username, userpart, pcname,
  pcip: string): string;
begin
 result:=#13#10;
 //result:=result+'[color=#aaaaaa]-----------------------------------------------------------[/color]'+#13#10;
 result:=result+'[color=#ffffaa]用户：[/color][color=#ffffff]'+username+'[/color][color=#ffffaa] 聊天组：[/color][color=#ffffff]'+userpart+'[/color][color=#ffffaa] 计算机：[/color][color=#ffffff]'+pcname+'[/color][color=#ffffaa] IP地址：[/color][color=#ffffff]'+pcip+' [/color]'+#13#10;
 result:=result+'[color=#aaaaaa]-----------------------------------------------------------[/color]';
end;

procedure Tform_main.updatecfg;
begin
 cfg.WriteString('pcinfo','user_name',form_main.user_name);
 cfg.WriteString('pcinfo','user_part',form_main.user_part);
 cfg.WriteInteger('config','conntimeout',form_main.conntimeout);
 cfg.WriteString('user','offresponse',form_main.offresponse);
 cfg.WriteBool('run','runonboot',form_main.runonboot);
 cfg.WriteString('config','msgsoundfilename',form_main.msgsoundfilename);
 cfg.WriteBool('config','alwplaysound',form_main.alwplaysound);
 cfg.WriteString('config','ipsect',stringreplace(form_main.ipsect,#13#10,';',[rfReplaceAll]));
end;

procedure Tform_main.readdatecfg;
begin
  form_main.user_name:=cfg.ReadString('pcinfo','user_name',form_main.IdIP.LocalName);
  form_main.user_part:=cfg.ReadString('pcinfo','user_part','group');
  form_main.conntimeout:=cfg.ReadInteger('config','conntimeout',1000);
  form_main.offresponse:=cfg.ReadString('user','offresponse','你好！我现在不在，一会和你联系。');
  form_main.runonboot:=cfg.ReadBool('run','runonboot',true);
  form_main.setrunonbootreg(form_main.runonboot);
  form_main.msgsoundfilename:=cfg.ReadString('config','msgsoundfilename',form_main.getsystemroot+'\Media\notify.wav');
  form_main.mp_msg.FileName:=form_main.msgsoundfilename;
  try
   form_main.mp_msg.Close;
   form_main.mp_msg.Open;
  except
  end;
  form_main.alwplaysound:=cfg.ReadBool('config','alwplaysound',true);
  form_main.ipsect:=stringreplace(cfg.ReadString('config','ipsect',''),';',#13#10,[rfReplaceAll]);
  if form_main.ipsect='' then
   form_main.ipsect:=form_main.extracipsect(form_main.IdIP.LocalIP); 
end;

procedure Tform_main.FormCreate(Sender: TObject);
var
ipsectfile:string;
localip:string;
begin
alwdownfilelist:=Tstringlist.Create;
form_main.pc_name:=idudp.LocalName;
localip:=form_main.IdIP.LocalIP;
ipsectfile:=extractfilepath(application.ExeName)+'/ipsects.txt';
cfg:=Tinifile.Create(extractfilepath(application.ExeName)+'\cfg.ini');
readdatecfg;
idhtp.Active:=true;
form_main.writingmsg:=false;
end;

function Tform_main.extracipsect(ip: string): string;
var
i:integer;
j:integer;
begin
i:=pos('.',ip);
for j:=1 to 3 do
  begin
   result:=result+copy(ip,0,i-1);
   if j<3 then
    result:=result+'.';
   ip:=copy(ip,i+1,length(ip)-i);
   i:=pos('.',ip);
  end;
end;




procedure Tform_main.N5Click(Sender: TObject);
begin
 form_config.show;
end;

procedure Tform_main.idudpUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  Dstream: TStringStream;
  rs:string;
  ts:Tstrings;
  tfile:Tstrings;
  filename:string;
  T:TgetpcThread;
  i:integer;
  msg:string;
  filestr:Tfilestream;
  buf:Tfilebuf;
  p:integer;
begin
  udpbusy:=true;
  Dstream := TStringStream.Create('');
  try
  ts:=Tstringlist.Create;