un_chart.pas

局域网的一个聊天程序

 for i:=1 to pc_list.Items.Count do
  pc_list.Items[i-1].Selected:=not pc_list.Items[i-1].Selected;
end;

procedure Tform_chat.ac_disableothersExecute(Sender: TObject);
var
i:integer;
begin
 for i:=1 to pc_list.Items.Count do
  pc_list.Items[i-1].Checked:=not pc_list.Items[i-1].Checked;
end;

procedure Tform_chat.ac_selectallExecute(Sender: TObject);
var
i:integer;
begin
 for i:=1 to pc_list.Items.Count do
  pc_list.Items[i-1].Selected:=true;
end;

procedure Tform_chat.ac_disableallExecute(Sender: TObject);
var
i:integer;
begin
 for i:=1 to pc_list.Items.Count do
  pc_list.Items[i-1].Checked:=false;
end;

function Tform_chat.pcexists(ip: string): boolean;
var
i:integer;
begin
result:=false;
  for i:=0 to form_chat.pc_list.Items.Count do
   begin
    if form_chat.pc_list.Items[i].SubItems.Strings[2]=ip then
     begin
      result:=true;
      break;
     end;
   end;

end;


procedure Tform_chat.mm_msginputChange(Sender: TObject);
begin
 if length((sender as Tmemo).Text)>(sender as Tmemo).MaxLength then
  (sender as Tmemo).Text:=copy((sender as Tmemo).Text,0,(sender as Tmemo).MaxLength);
 lb_sizecnt.Caption:=inttostr(length((sender as Tmemo).Text))+'/'+inttostr((sender as Tmemo).maxlength);
end;

procedure Tform_chat.reqdeletepcall;
var
i:integer;
j:integer;
s:Tstrings;
k:integer;
T:TreqdeletepcThread;
begin
  inherited;
form_chat.reqdeletepccnt:=0;
s:=Tstringlist.Create;
s.Text:=form_main.ipsect;
for i:=1 to s.count do
 begin
  for j:=1 to 254 do
   begin
    k:=0;
    while (form_chat.reqdeletepccnt=50) and (k<1000) do
     begin
      k:=k+1;
      sleep(10);
     end;
    T:=TreqdeletepcThread.Create(true);
    t.ip:=s.Strings[i-1]+'.'+inttostr(j);
    form_chat.reqdeletepccnt:=form_chat.reqdeletepccnt+1;
    t.Resume;
   end;
 end;
 k:=0;
 while (form_chat.reqdeletepccnt<>0) and (k<1000) do
  begin
   k:=k+1;
   sleep(10);
  end;
end;

procedure Tform_chat.ac_setstatusExecute(Sender: TObject);
var
t:TsetstatusThread;
begin
  t:=TsetstatusThread.Create(false);
end;

{ TsendmsgoffThread }

procedure TsendmsgoffThread.Execute;
var
udpc:Tidudpclient;
s:Tstrings;
rs:string;
msg:string;
begin
  inherited;
  s:=Tstringlist.Create;
  udpc:=Tidudpclient.Create(nil);
  try
  udpc.Host:=ip;
  udpc.Port:=3001;
  udpc.ReceiveTimeout:=10000;
  s.Text:='chat_off'+#13#10+httpencode(Threadmsg);
  udpc.Send(s.Text);
  rs:=udpc.ReceiveString;
  if rs='' then
   begin
    msg:='[color=#ff0000]无法发送消息至 '+ip+' '+datetimetostr(now)+'[/color]'+#13#10;
    msg:=msg+'消息内容：'+#13#10;
    msg:=msg+Threadmsg+#13#10+#13#10;
    form_main.writemsg(msg);
    application.ProcessMessages;
   end;
  except
  end; 
  udpc.Destroy;;
  s.Destroy;
end;

procedure Tform_chat.ac_setoffresponseExecute(Sender: TObject);
begin
 form_main.offresponse:=form_chat.inputval('离开自动回复消息','请输入离开自动回复的消息内容！消息为空时不回复。',form_main.offresponse); 
end;

function Tform_chat.getubb(ubb, pa, s: string): string;
begin
 result:='['+ubb;
 if pa<>'' then
  result:=result+'='+pa;
 result:=result+']'+s+'[/'+ubb+']';
end;

procedure Tform_chat.ac_sendlocalflashExecute(Sender: TObject);
var
i:integer;
begin
form_main.op_file.Filter:='flash 动画|*.swf|所有文件|*.*';
form_main.op_file.Title:='请选择要张贴的动画文件';
form_main.op_file.Options:=[ofHideReadOnly,ofNoChangeDir,ofAllowMultiSelect,ofEnableSizing];
//form_main.op_file.Options:=[ofHideReadOnly,ofNoChangeDir,ofEnableSizing];
 if form_main.op_file.Execute then
  begin
  for i:=1 to form_main.op_file.Files.Count do
   begin
    mm_msginput.Text:=mm_msginput.Text+form_chat.getubb('flash','',getlocalfileurl(form_main.op_file.Files.Strings[i-1],true));
    form_main.addto_alwdownfilelist(form_main.op_file.Files.Strings[i-1]);
   end
  end;
end;

procedure Tform_chat.ac_sendnetflashExecute(Sender: TObject);
var
s:string;
begin
  s:=inputval('选择网络上的动画','请输入网络上动画的位置','http://');
  if s<>'' then
   mm_msginput.Text:=mm_msginput.Text+form_chat.getubb('flash','',s);
end;


procedure Tform_chat.ac_sendlocalmpExecute(Sender: TObject);
var
p:string;
begin
p:=form_chat.inputval('输入宽度','请输入Windows Media Player播放的宽度','400');
p:=p+','+form_chat.inputval('输入高度','请输入Windows Media Player播放的高度','350');
form_main.op_file.Filter:='所有文件|*.*';
form_main.op_file.Title:='请选择要张贴的Windows Media Player媒体文件';
form_main.op_file.Options:=[ofHideReadOnly,ofNoChangeDir,ofEnableSizing];
 if form_main.op_file.Execute then
  begin
    mm_msginput.Text:=mm_msginput.Text+form_chat.getubb('mp',p,getlocalfileurl(form_main.op_file.FileName,false));
    form_main.addto_alwdownfilelist(form_main.op_file.FileName);
  end;
end;

procedure Tform_chat.ac_sendnetmpExecute(Sender: TObject);
var
p:string;
begin
p:=form_chat.inputval('输入宽度','请输入Windows Media Player播放的宽度','400');
p:=p+','+form_chat.inputval('输入高度','请输入Windows Media Player播放的高度','350');
mm_msginput.Text:=mm_msginput.Text+form_chat.getubb('mp',p,form_chat.inputval('输入位置','请输入网络上Windows Media Player媒体的位置','http://'));
end;

procedure Tform_chat.ac_sendlocalrmExecute(Sender: TObject);
var
p:string;
begin
p:=form_chat.inputval('输入宽度','请输入Real Player播放的宽度','400');
p:=p+','+form_chat.inputval('输入高度','请输入Real Player播放的高度','350');
form_main.op_file.Filter:='所有文件|*.*';
form_main.op_file.Title:='请选择要张贴的Real Player媒体文件';
form_main.op_file.Options:=[ofHideReadOnly,ofNoChangeDir,ofEnableSizing];
 if form_main.op_file.Execute then
  begin
    mm_msginput.Text:=mm_msginput.Text+form_chat.getubb('rm',p,getlocalfileurl(form_main.op_file.FileName,false));
    form_main.addto_alwdownfilelist(form_main.op_file.FileName);
  end;
end;

procedure Tform_chat.ac_sendnetrmExecute(Sender: TObject);
var
p:string;
begin
p:=form_chat.inputval('输入宽度','请输入Real Player播放的宽度','400');
p:=p+','+form_chat.inputval('输入高度','请输入Real Player播放的高度','350');
mm_msginput.Text:=mm_msginput.Text+form_chat.getubb('rm',p,form_chat.inputval('输入位置','请输入网络上Real Player媒体的位置','http://'));
end;

function Tform_chat.getlocalfileurl(filename:string;ctfilename:bool):string;
begin
 result:='http://'+form_main.IdIP.LocalIP+':3000/file/';
 if ctfilename then
  result:=result+extractfilename(FileName)
 else
  result:=result+formatdatetime('yyyymmddhhmmss',now)+extractfileext(filename);
  result:=result+'?'+httpencode(filename);
end;

procedure Tform_chat.ac_viewtextmsgExecute(Sender: TObject);
begin
Splitter3.Visible:=not Splitter3.Visible;
mm_msgall.Visible:=not mm_msgall.Visible;
Splitter3.Top:=mm_msgall.Top;
end;

procedure Tform_chat.ac_savemsgtextExecute(Sender: TObject);
var
ts:string;
begin
 ts:=formatdatetime('yyyy年mm月dd日 hh时mm分ss秒',now);
 form_main.sv_file.Filter:='文本文件|*.txt;*.text';
 form_main.sv_file.Title:='聊天记录保存';
 form_main.sv_file.FileName:=form_main.sv_file.InitialDir+'快讯聊天记录 '+ts+'.txt';
  if form_main.sv_file.Execute then
   begin
    form_chat.mm_msgall.Lines.SaveToFile(form_main.sv_file.FileName);
   end;
end;

procedure Tform_chat.FormResize(Sender: TObject);
begin
 checkmsg;
end;

{ TreqaddallThread }

procedure TreqaddpcThread.Execute;
begin
  inherited;
  form_chat.reqaddpc(ip,true);
  form_chat.reqaddpccnt:=form_chat.reqaddpccnt-1;
end;

procedure Tform_chat.ac_cleanuserlistExecute(Sender: TObject);
begin
 pc_list.Items.Clear;
end;

{ TreqaddpcallThread }

procedure TreqaddpcallThread.Execute;
var
i:integer;
j:integer;
s:Tstrings;
k:integer;
T:TreqaddpcThread;
begin
  inherited;
form_chat.reqaddpccnt:=0;
form_chat.ac_refreshuserlist.Enabled:=false;
s:=Tstringlist.Create;
s.Text:=form_main.ipsect;
for i:=1 to s.count do
 begin
  for j:=1 to 254 do
   begin
    k:=0;
    while (form_chat.reqaddpccnt=50) and (k<1000) do
     begin
      k:=k+1;
      sleep(10);
     end;
    T:=TreqaddpcThread.Create(true);
    t.ip:=s.Strings[i-1]+'.'+inttostr(j);
    form_chat.reqaddpccnt:=form_chat.reqaddpccnt+1;
    t.Resume;
   end;
 end;
 k:=0;
 while (form_chat.reqaddpccnt<>0) and (k<1000) do
  begin
   k:=k+1;
   sleep(10);
  end;
form_chat.ac_refreshuserlist.Enabled:=true;
end;

{ TreqdeletepcThread }

procedure TreqdeletepcThread.Execute;
begin
  inherited;
  form_chat.reqdeletepc(ip);
  form_chat.reqdeletepccnt:=form_chat.reqdeletepccnt-1;
end;

{ TchangestatusThread }

procedure TsetstatusThread.Execute;
var
i:integer;
j:integer;
s:Tstrings;
k:integer;
T:TreqsetstatusThread;
cmd:string;
begin
  inherited;
 if form_chat.ac_setstatus.Caption='在线' then
  begin
   form_chat.ac_setstatus.Caption:='离开';
   form_chat.StatusBar1.Panels.Items[3].Text:='状态：在线';
   cmd:='useron';
  end
 else
  begin
   form_chat.ac_setstatus.Caption:='在线';
   form_chat.StatusBar1.Panels.Items[3].Text:='状态：离开';
   cmd:='useroff';
  end;


form_chat.reqsetstatuscnt:=0;
form_chat.ac_setstatus.Enabled:=false;
s:=Tstringlist.Create;
s.Text:=form_main.ipsect;
for i:=1 to s.count do
 begin
  for j:=1 to 254 do
   begin
    k:=0;
    while (form_chat.reqsetstatuscnt=50) and (k<1000) do
     begin
      k:=k+1;
      sleep(10);
     end;
    T:=TreqsetstatusThread.Create(true);
    t.ip:=s.Strings[i-1]+'.'+inttostr(j);
    t.cmd:=cmd;
    form_chat.reqsetstatuscnt:=form_chat.reqsetstatuscnt+1;
    t.Resume;
   end;
 end;
 k:=0;
 while (form_chat.reqsetstatuscnt<>0) and (k<1000) do
  begin
   k:=k+1;
   sleep(10);
  end;
form_chat.ac_setstatus.Enabled:=true;
end;

function Tform_chat.reqsetstatus(ip:string;cmd:string):boolean;
var
udpc:TIdUdpclient;
begin
udpc:=TIdUdpclient.Create(nil);
udpc.Host:=ip;
udpc.Port:=3001;
 try
  udpc.ReceiveTimeout:=form_main.conntimeout;
  udpc.Send(cmd);
 result:=true;
 except
 result:=false;
 end;
udpc.Destroy;
end;

{ TreqsetstatusThread }

procedure TreqsetstatusThread.Execute;
begin
  inherited;
 form_chat.reqsetstatus(ip,cmd);
 form_chat.reqsetstatuscnt:=form_chat.reqsetstatuscnt-1;
end;

procedure Tform_chat.pc_listDeletion(Sender: TObject; Item: TListItem);
begin
 form_chat.pc_list.Columns[0].Caption:='用户: '+inttostr(form_chat.pc_list.Items.Count-1);
end;

procedure Tform_chat.pc_listInsert(Sender: TObject; Item: TListItem);
begin
 form_chat.pc_list.Columns[0].Caption:='用户: '+inttostr(form_chat.pc_list.Items.Count);
end;

procedure Tform_chat.FormActivate(Sender: TObject);
begin
 application.ProcessMessages;
end;

end.