Delphi ChatRoom_Example

聊天用户发言分色显示

procedure TForm1.Button3Click(Sender: TObject);
begin
RichEdit1.SelStart := MaxInt;
RichEdit1.SelAttributes.Color := clblue;
RichEdit1.Lines.Add(DateTimeToStr(Now)+ '大宝 说: ');
RichEdit1.Lines.Add(' '+Memo1.Text);
end;

一,Server(主要代码)

procedure TForm1.FormCreate(Sender: TObject);
begin
   serversocket1.Active :=true;
   RichEdit1.Lines.add(datetostr(date)+' '+timetostr(time)+'==>'+'聊天室服务器启动了');
   StatusBar1.SimpleText:='聊天室服务器启动了';
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var   s,str,name,nei_rong:string;
      i,n:integer;
      all_name,ni_cheng:string;
      newitem:TListItem;
begin
   s:=Socket.ReceiveText; //接收字符串
   n:=pos('@',s);
   if n>0 then
   begin
      str:=copy(s,1,n-1);
      if str='交谈' then //格式:"交谈"@"to昵称"@"内容"
      begin
         str:=copy(s,n+1,length(s)-n);
         name:=copy(str,3,pos('@',str)-3); //交谈的对象昵称
         nei_rong:=copy(str,pos('@',str)+1,length(str)-pos('@',str));//交谈的内容
         for i:=0 to ListView1.Items.count-1 do //根据发言者IP找发言者昵称
         begin
           if socket.RemoteAddress=ListView1.Items[i].subitems[0] then
             begin
             ni_cheng:= ListView1.Items[i].caption;
             RichEdit1.Lines.add(ni_cheng+'对'+name+'说'+nei_rong);              end;
         end;

         for i:=0 to ListView1.Items.count-1 do //根据交谈的对象昵称找交谈的对象IP
         begin
           if name=ListView1.Items[i].caption then
             name:=ListView1.Items[i].subitems[0]; //subitems[0]存放IP
         end;

         for i:=0 to ListView1.Items.count-1 do //实现私聊
            begin
             if ServerSocket1.Socket.Connections[i].RemoteAddress=name then
              ServerSocket1.Socket.Connections[i].SendText('交谈@'+ni_cheng+'@'+nei_rong);
            end;
       end;
      if str='昵称' then //昵称@xmj
      begin
        all_name:='';
        newitem:=ListView1.Items.insert(ListView1.Items.count);

        newitem.caption:=copy(s,pos('@',s)+1,length(s)-pos('@',s));
        newitem.SubItems.Add(socket.RemoteAddress);
        newitem.SubItems.Add(socket.RemoteHost);
        RichEdit1.Lines.add(newitem.caption+'进来了');
        for i:=0 to ListView1.Items.count-1 do
        all_name:=all_name+ListView1.Items[i].Caption +'^'+ListView1.Items[i].subitems[0]+'@';
        for i:=0 to ListView1.Items.count-1 do //广播新进入用户
        begin
         ServerSocket1.Socket.Connections[i].SendText('添加用户@'+all_name);
        end;
      end;
   end;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);      //用户离开触发
var i:integer;ni_cheng:string;
begin
        for i:=0 to ListView1.Items.count-1 do //根据发言者IP找发言者昵称
         begin
           if socket.RemoteAddress=ListView1.Items[i].subitems[0] then
             begin
             ni_cheng:= ListView1.Items[i].caption;
             RichEdit1.Lines.add(ni_cheng+'离开了');
             end;
         end;
       for i:=0 to ListView1.items.count-1 do //ListView1中查找离开用户
         begin
         if Socket.RemoteAddress= ListView1.Items[i].subitems[0] then
            Listview1.Items.Item[i].Delete();
         end;
      for i:=0 to ListView1.items.count-1 do    //广播离开用户
         ServerSocket1.Socket.Connections[i].SendText('离开@'+ListView1.Items[i].caption);

end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var i:integer;
begin
if key=13 then
    begin
      for i:=0 to ListView1.items.count-1 do //广播用户
      begin
      ServerSocket1.Socket.Connections[i].SendText('交谈@'+'all'+'@'+edit1.Text );
      edit1.text:='';
      end;
    end;
end;

end.

二;Client(主要代码)

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
    if key=13 then //最好加本地IP
    begin
      if listbox1.itemindex>=0 then
       begin
       clientsocket1.Socket.SendText('交谈@'+'to'+listBox1.Items.strings[listbox1.itemindex]+'@ '+edit1.Text );
       edit1.text:='';
       end
      else
       showmessage('请选择交谈对象');

    end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// clientsocket1.Socket.SendText('离开@');
   clientsocket1.Active :=false;
   clientsocket1.close;
end;

procedure TForm1.Button1Click(Sender: TObject);
var str1:string;
begin
    str1:=inputbox('建立连接','请输入IP','127.0.0.1');
    if trim(str1)<>'' then
    begin
       clientsocket1.Port:=5555;//server port
       clientsocket1.host:=str1;
       try
       clientsocket1.active:=true;
       str1:=inputbox('建立连接','请输入昵称','泡泡');
       clientsocket1.Socket.SendText('昵称@'+str1);
       except
       showmessage('连接失败');
       end;
    end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin

    close;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
    StatusBar1.SimpleText:='连接成功';
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var str1,name,str2,nei_rong:string;
    n,i:integer;
begin
    str1:=socket.ReceiveText;
    str2:=copy(str1,1,pos('@',str1)-1);
    if str2='添加用户' then
      begin
        listbox1.Clear;//清除已有名单
        str1:=copy(str1,pos('@',str1)+1,length(str1)-pos('@',str1));
        while str1<>'' do //建立新名单
        begin
         name:=copy(str1,1,pos('@',str1)-1);//昵称^IP
         listbox1.Items.Add(copy(name,1,pos('^',name)-1));
         str1:=copy(str1,pos('@',str1)+1,length(str1)-pos('@',str1));
        end;
      RichEdit1.Lines.Add(name+'进入了');
      end;

    if str2='交谈' then   //交谈@xmj@hello
      begin
        str2:=copy(str1,pos('@',str1)+1,length(str1)-pos('@',str1));
        name:=copy(str2,1,pos('@',str2)-1);
        nei_rong:=copy(str2,pos('@',str2)+1,length(str2)-pos('@',str2));
        RichEdit1.Lines.Add(name+'对你说'+nei_rong);
      end;
    if str2='离开' then
      begin
         n:= pos('@',str1);
         name:=copy(str1,n+1,length(str1)-n);
         for i:=0 to listbox1.items.count-1 do
         begin
           if listbox1.items.strings[i]=name then
             listbox1.items.delete(i);
         end;
      end;
end;

end.