un_main.pas

局域网的一个聊天程序

  Dstream.CopyFrom(AData, AData.Size);
  ts.Text:=dstream.DataString;
   if (ts.Strings[0]='getpcinfo') then
    begin
     rs:=form_main.IdIP.LocalIP+#13#10+form_main.user_name+#13#10+form_main.user_part+#13#10+form_main.pc_name+#13#10+form_chat.ac_setstatus.Caption;
     ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, rs[1], Length(rs));
    end
   else if (ts.Strings[0]='deleteuser') then  //接受网络的删除用户消息
    begin
    if ABinding.PeerIP<>form_main.IdIP.LocalIP then
     form_chat.deleteuser(ABinding.PeerIP);
    end
   else if (ts.Strings[0]='useroff') then  //接受网络的用户离开消息
    begin
     with form_chat.finduserbyip(ABinding.PeerIP,true) do
      imageindex:=2;
    end
   else if (ts.Strings[0]='useron') then  //接受网络的用户上线消息
    begin
     with form_chat.finduserbyip(ABinding.PeerIP,true) do
      imageindex:=3;
    end
   else if (ts.Strings[0]='adduser') then  //接受网络的用户添加消息
    begin
     //if ABinding.PeerIP<>form_main.get_pc_ip(form_main.pc_name) then
      begin
       t:=TgetpcThread.Create(true);
       t.iplist:=Tstringlist.Create;
       t.iplist.Add(ABinding.PeerIP);
       t.reqadd:=false;
       t.Resume;
      end;
    end
   else if (ts.Strings[0]='adduser_login') then  //接受网络的删除用户退出消息
    begin
       t:=TgetpcThread.Create(true);
       t.iplist:=Tstringlist.Create;
       t.iplist.Add(ABinding.PeerIP);
       t.reqadd:=false;
       t.Resume;
     //if ABinding.PeerIP<>form_main.get_pc_ip(form_main.pc_name) then
      //begin
       form_chat.reqaddpc(ABinding.PeerIP,false);
      //end;
    end
   else if (ts.Strings[0]='chat') then  //接受网络的用户聊天消息
    begin
     //form_chat.getpcinfo(ABinding.PeerIP);
     with form_chat.finduserbyip(ABinding.PeerIP,true) do
      begin
       if checked then
        begin
         msg:='[color=#ffff00]'+formatdatetime('yy-mm-dd hh:mm:ss',now)+' 接收消息 [/color]';
         msg:=msg+form_main.get_user_infostring(caption,subitems.Strings[0],subitems.Strings[1],ABinding.PeerIP)+#13#10;
         subitems.Strings[4]:=inttostr(strtoint(subitems.Strings[4])+1);
         msg:=msg+httpdecode(ts.Strings[1])+#13#10+#13#10;
         tim_writemsg.Enabled:=true;
         if not tim_flasicon.Enabled then
          tim_flasicon.Enabled:=true;
         form_main.writemsg(msg);
         form_main.playsound('message');
         rs:='ok';
         form_main.responsestatus(ABinding.PeerIP);
        end
       else
        begin
         rs:='';
        end;
     end;
     ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, rs[1], Length(rs));
    end
   else if (ts.Strings[0]='chat_off') then  //接受网络的用户离开时的消息
    begin
     with form_chat.finduserbyip(ABinding.PeerIP,false) do
      begin
       if checked then
        begin
         msg:='[color=#ffff00]'+formatdatetime('yy-mm-dd hh:mm:ss',now)+' 用户离开 [/color]';
         msg:=msg+form_main.get_user_infostring(caption,subitems.Strings[0],subitems.Strings[1],ABinding.PeerIP)+#13#10;
         subitems.Strings[4]:=inttostr(strtoint(subitems.Strings[4])+1);
         msg:=msg+httpdecode(ts.Strings[1])+#13#10+#13#10;
         form_main.writemsg(msg);
         if not tim_flasicon.Enabled then
          tim_flasicon.Enabled:=true;
         form_main.playsound('message');
         rs:='ok';
        end
       else
        begin
         rs:='';
        end;
     end;
     ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, rs[1], Length(rs));
    end
   else if (ts.Strings[0]='getfile') then
    begin
     with form_chat.finduserbyip(ABinding.PeerIP,true) do
      begin
       rs:='';
       if checked then
        begin
         msg:='[color=#ff0000]'+formatdatetime('yy-mm-dd hh:mm:ss',now)+' 文件接收 [/color]';
         msg:=msg+form_main.get_user_infostring(caption,subitems.Strings[0],subitems.Strings[1],ABinding.PeerIP)+#13#10;
         subitems.Strings[4]:=inttostr(strtoint(subitems.Strings[4])+1);
         msg:=msg+'[color=#ff0000]注意：[/color][color=#ffff00]来自网络的文件可能含有有害信息，请先对文件进行病毒检查再打开！[/color]'+#13#10+'接收时可直接点击“接收”，或在“接受”上点右键，选择“目标另存为”，或者使用下载工具下载。'+#13#10;
         msg:=msg+'文件：'+#13#10;
         tfile:=Tstringlist.Create;
         tfile.Text:=httpdecode(ts.Strings[1]);
         for i:=1 to tfile.Count do
          begin
           if tfile.Strings[i-1]<>'' then
            begin
             filename:=extractfilename(httpdecode(tfile.Strings[i-1]));
             msg:=msg+'[color=#ffff00]'+filename+'[/color] [url=http://'+ABinding.PeerIP+':3000/file/'+filename+'?'+httpencode(tfile.Strings[i-1])+']接收'+'[/url]'+#13#10;
            end;
          end;
         tfile.Destroy;
         msg:=msg+#13#10;
         form_main.writemsg(msg);
         if not tim_flasicon.Enabled then
         tim_flasicon.Enabled:=true;
         form_main.playsound('message');
         rs:='ok';
         form_main.responsestatus(ABinding.PeerIP);
       end;
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, rs[1], Length(rs)); 
     end;
    end
   else if (ts.Strings[0]='file') then  //文件访问
    begin
       //showmessage(ts.Strings[0]);
     if fileexists(ts.Strings[1]) {and (pos(ts.Strings[1],alwdownfilelist.Text)<>0)} then
      begin
       //showmessage(ts.Strings[0]);
       zeromemory(@buf,sizeof(buf));
       p:=strtoint(ts.Strings[2]);
       buf.pos:=p;
       filestr:=Tfilestream.Create(ts.Strings[1],fmOpenRead);
       buf.size:=filestr.Size;
       filestr.Position:=(p-1)*sizeof(buf.buf);
       filestr.Read(buf.buf,sizeof(buf.buf));
       filestr.Destroy;
       ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, buf, sizeof(buf));
      end; 
    end
     else
      begin
       rs:='';
       ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, rs[1], Length(rs));
      end;       


  ts.Free;
  except
  end;
  dstream.Destroy;
  udpbusy:=false;
end;



procedure Tform_main.responsestatus(ip: string);
var
 Toff:TsendmsgoffThread;
begin
 if (form_chat.ac_setstatus.Caption='在线') and (form_main.offresponse<>'') then
  begin
   toff:=TsendmsgoffThread.Create(true);
   toff.ip:=ip;
   toff.threadmsg:=form_main.offresponse;
   toff.FreeOnTerminate:=true;
   toff.Resume;
  end;
end;

procedure Tform_main.writemsg(msg: String);
begin
 if form_chat.Visible then
  begin
   form_main.writemsgintime(msg);
  end
 else
  begin
   form_main.msghide:=form_main.msghide+msg;
  end;  
end;


procedure Tform_main.writemsgintime(msg: String);
var
i:integer;
begin
 i:=0;
  while (form_main.writingmsg) and (i<100) do
   begin
    sleep(10);
    i:=i+1;
   end;
 form_chat.mm_msgall.Lines.Add(msg);  
 form_main.writingmsg:=true;
 form_main.msg:=msg;
 form_main.tim_writemsg.Enabled:=true;
end;

procedure Tform_main.setrunonbootreg(run: bool);
var
r:Tregistry;
begin
 r:=Tregistry.Create;
 r.RootKey:=HKEY_LOCAL_MACHINE;
 r.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',true);
 if run then
  r.WriteString('Quick Message',application.ExeName)
 else
  r.DeleteValue('Quick Message');
 r.Destroy;
end;

function Tform_main.getsystemroot: string;
var
r:Tregistry;
begin
 result:='';
 r:=Tregistry.Create;
 r.RootKey:=HKEY_LOCAL_MACHINE;
 r.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion',true);
 if r.ValueExists('SystemRoot') then
  begin
   result:=r.ReadString('SystemRoot')
  end
 else
  begin
   r.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion',true);
   if r.ValueExists('SystemRoot') then
    begin
     result:=r.ReadString('SystemRoot')
    end;
  end;
 r.Destroy;
end;

procedure Tform_main.playsound(sound: string);
begin
if form_main.alwplaysound then
 begin
  if sound='message' then
   begin
    try
     form_main.mp_msg.Open;
     form_main.mp_msg.Play;
    except
     beep;
    end;
   end;
 end;
end;


procedure Tform_main.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
try
form_chat.Close;
form_chat.reqdeletepcall;
form_main.RzTrayIcon1.Enabled:=false;
idhtp.Active:=false;
alwdownfilelist.Free;
updatecfg;
cfg.UpdateFile;
cfg.Destroy;
if udpbusy then
application.Terminate;
except
 application.Terminate;
end;

end;

procedure Tform_main.PopupMenu1Popup(Sender: TObject);
begin
  application.ProcessMessages;
end;

procedure Tform_main.op_fileCanClose(Sender: TObject;
  var CanClose: Boolean);
begin
 if (sender as Topendialog).Files.Count>10 then
  begin
   messagebox(handle,'最多可以选择10个文件！','文件过多',mb_ok+mb_iconerror);
   canclose:=false;
  end;
end;

initialization
hnd := CreateMutex(nil, True, 'Quick Message 快讯');
if GetLastError = ERROR_ALREADY_EXISTS then Halt;

finalization
if hnd <> 0 then CloseHandle(hnd);

end.