二叔接分来了

Question

服务器端
unit uServer;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
  IdComponent, IdUDPBase, IdUDPServer, ImgList, IdSocketHandle;type
  TfrmMain = class(TForm)
    TreeView1: TTreeView;
    ListView1: TListView;
    ImageList1: TImageList;
    UDPServer: TIdUDPServer;
    UDPAntiFreeze: TIdAntiFreeze;
    procedure FormCreate(Sender: TObject);
    procedure UDPServerUDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure TreeView1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function GetOnlineList:string;
  end;const
  SERVER_PORT = 8000;
  CLIENT_PORT = 8001;type
  TMsgType = (LOGIN, ONLIE_LIST, INFO, BROADCAST, LOGOUT);  TMsgInfo = ^MsgInfo;
    MsgInfo  = record
    msgtype:TMsgType;
    nikename:array [0..9]  of char;
    sex:     array [0..3]  of char;
    from_ip: array [0..15] of char;
    to_ip:   array [0..15] of char;
    info:    array [0..1023] of char;
  end;var
  frmMain: TfrmMain;implementation{$R *.dfm}procedure TfrmMain.FormCreate(Sender: TObject);
begin
  UDPServer.DefaultPort:= SERVER_PORT;
  UDPServer.Active := True;
end;
procedure TfrmMain.UDPServerUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  Item:TListItem;
  send_msg,recv_msg:MsgInfo;
  msg_type:TMsgType;
  pmsg:TMsgInfo;
  Node:TTreeNode;
  myinfo,client_list:string;
begin
    try
      FillChar(recv_msg, sizeof(recv_msg), #0);
      AData.ReadBuffer(recv_msg, sizeof(recv_msg));
    Except
      on exception do
        MessageDlg('读取数据失败！', mtError, [mbOk],0);
    end;
    if (recv_msg.msgtype = LOGIN) then      //登录
    begin
      //添加在线名单
      New(pmsg);
      pmsg^:= recv_msg;
      with TreeView1 do
      begin
        Node:= TreeView1.Items.AddChildObject(TreeView1.Items[0],recv_msg.nikename,pmsg);
        Node.ImageIndex:= 1;
        Node.SelectedIndex:=1;
        TreeView1.Refresh;
        TreeView1.FullExpand;
      end;
      //向客户端发送在线名单
      client_list := GetOnlineList;
      Node:= TreeView1.Items[0].getFirstChild;
      while (Node<>nil) do
      begin
        FillChar(send_msg,sizeof(send_msg),#0);
        msg_type:= ONLIE_LIST;
        send_msg.msgtype := msg_type;
        StrPcopy(send_msg.info,client_list);
        ABinding.SendTo(TMsgInfo(Node.Data)^.from_ip, CLIENT_PORT, send_msg, sizeof(send_msg));
        Node:= Node.GetNext;
      end;
    end
    else if (recv_msg.msgtype = LOGOUT) then     //退出
    begin
      Node:= TreeView1.Items[0].getFirstChild;
      while (Node<>nil) do
      begin
        if Node.Text = recv_msg.nikename then
          Node.Delete;
        Node := Node.GetNext;
      end;
    end
    else if (recv_msg.msgtype = INFO) then
    begin
      Item := ListView1.Items.Add;
      Item.Caption:= recv_msg.nikename;
      Item.SubItems.Add(ABinding.PeerIP);
      Item.SubItems.Add(recv_msg.to_ip);
      myinfo:= Trim(recv_msg.info);
      Item.SubItems.Add(myinfo);
      Item.SubItems.Add(FormatDateTime('yyyy-mm-dd hh:mm:ss',Now));
      if (Pos('色情',myinfo)>0) or (Pos('淫秽',myinfo)>0) or (Pos('凶杀',myinfo)>0)
        or (Pos('恐怖',myinfo)>0)  then
          Exit;
      //转发数据
      FillChar(send_msg,sizeof(send_msg),#0);
      msg_type:= INFO;
      send_msg.msgtype := msg_type;
      StrPcopy(send_msg.nikename, recv_msg.nikename);
      StrPcopy(send_msg.info, recv_msg.info);
      ABinding.SendTo(recv_msg.to_ip, CLIENT_PORT, send_msg, sizeof(send_msg));
    end;
end;function TfrmMain.GetOnlineList:string;
var
  Node:TTreeNode;
  List:String;
begin
  List:='';
  Node:= TreeView1.Items[0].getFirstChild;
  while (Node<>nil) do
  begin
    if (TMsgInfo(Node.Data)^.nikename<>'') and (TMsgInfo(Node.Data)^.from_ip<>'') then
      List:= List + TMsgInfo(Node.Data)^.nikename + ',' + TMsgInfo(Node.Data)^.from_ip +';';
    Node:= Node.GetNext;
  end;
  result:= List;
end;procedure TfrmMain.TreeView1DblClick(Sender: TObject);
begin
  if TreeView1.Selected.Level=0 then Exit;
  ShowMessage('对方IP：'+ TMsgInfo(TreeView1.Selected.Data)^.from_ip);
end;end.

Answer 1

客户端
unit uClient;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
  IdComponent, IdUDPBase, IdUDPClient ,Idstack, IdUDPServer, IdSocketHandle,
  ComCtrls, ImgList, IniFiles;type
  TfrmMain = class(TForm)
    memRecv: TMemo;
    UDPClient: TIdUDPServer;
    IdAntiFreeze1: TIdAntiFreeze;
    TreeView1: TTreeView;
    Label2: TLabel;
    ImageList1: TImageList;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure UDPClientUDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure FormShow(Sender: TObject);
    procedure TreeView1DblClick(Sender: TObject);
  private
    { Private declarations }
    isExit:Boolean;
    islogin:Boolean;
    server_addr:string;
    user_nike:string;
  public
    { Public declarations }
    procedure ClientLogIn;
    procedure ClientLogOut;
    function  ParseList(OnlineList:string):Boolean;
  end;type
  TMsgType = (LOGIN, ONLIE_LIST, INFO, BROADCAST, LOGOUT);  TMsgInfo = ^MsgInfo;
    MsgInfo  = record
    msgtype:TMsgType;
    nikename:array [0..9]  of char;
    sex:     array [0..3]  of char;
    from_ip: array [0..15] of char;
    to_ip:   array [0..15] of char;
    info:    array [0..1023] of char;
  end;const
  //SERVER_ADDR = '127.0.0.1';
  SERVER_PORT = 8000;
  CLIENT_PORT = 8001;var
  frmMain: TfrmMain;implementation
  uses uConfig, uSend, Unit1;{$R *.dfm}procedure TfrmMain.ClientLogIn;
var
  msg :MsgInfo;
  msgtype :TMsgType;
begin
  FillChar(msg, sizeof(msg), #0);
  msgtype := LOGIN;
  msg.MsgType := msgtype;
  StrPcopy(msg.nikename, user_nike);
  StrPcopy(msg.from_ip, GStack.LocalAddress);
  try
    UDPClient.SendBuffer(SERVER_ADDR, SERVER_PORT, msg, sizeof(msg));
    //接收服务器消息
  except
    on exception do
      MessageDlg('登录服务器失败！', mtWarning, [mbOK], 0);
  end;
end;procedure TfrmMain.ClientLogOut;
var
  msg :MsgInfo;
  msgtype :TMsgType;
begin
  FillChar(msg, sizeof(msg), #0);
  msgtype := LOGOUT;
  msg.MsgType := msgtype;
  StrPcopy(msg.nikename, user_nike);
  try
    UDPClient.SendBuffer(SERVER_ADDR, SERVER_PORT, msg, sizeof(msg));
   except
    on exception do
      MessageDlg('发送信息失败！', mtWarning, [mbOK], 0);
  end;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ClientLogOut;
end;procedure TfrmMain.UDPClientUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  msg: MsgInfo;
  OnlineList:string;
begin
  //接收信息
  FillChar(msg, sizeof(msg), #0);
  try
    AData.Read(msg, sizeof(msg));
  except
    on exception do
    begin
      MessageDlg('接收信息失败！', mtWarning, [mbOK], 0);
      Exit;
    end;
  end;
  if (msg.msgtype = ONLIE_LIST) then
  begin
    islogin := True;
    memRecv.Lines.Add('登录成功！');
    OnlineList:= msg.info;
    ParseList(OnlineList);
  end
  else if (msg.msgtype = INFO) then
    memRecv.Lines.Add(msg.nikename + '：' +msg.info)
end;procedure TfrmMain.FormShow(Sender: TObject);
var
  ConfigFile:TIniFile;
  filePath:string;
  IniForm:TfrmConfig;
begin
  filePath:= ExtractFilePath(ParamStr(0)) + 'Config.ini';
  ConfigFile:= TIniFile.Create(filePath);
  try
    user_nike:= ConfigFile.ReadString('用户资料','昵称','');
    server_addr:= ConfigFile.ReadString('服务器配置','地址','');
    if (user_nike='') or (server_addr='') then
    begin
      IniForm := TfrmConfig.Create(self);
      with IniForm do
      try
        ShowModal;
        if IniForm.ModalResult = mrOK then
        begin
          isExit:= False;
          user_nike:= Trim(IniForm.etNick.Text);
          server_addr:= Trim(IniForm.etServerIp.Text);
          ConfigFile.WriteString('用户资料','昵称',user_nike);
          ConfigFile.WriteString('服务器配置','地址',server_addr);
        end
        else
          isExit:=True;
      finally
        IniForm.Free;
      end;
    end;
  finally
    ConfigFile.Free;
  end;   if isExit then
    Halt;  UDPClient.DefaultPort:= CLIENT_PORT;
  UDPClient.Active:= True;
  ClientLogIn;
end;function TfrmMain.ParseList(OnlineList:string):Boolean;
var
  Index,semicolon,dot:Integer;
  u_info,nike,ip:string;
  Node:TTreeNode;
  u_msg:MsgInfo;
  pmsg:TMsgInfo;
begin
  result:= False;
  Index:=0;
  TreeView1.Items.Clear;
  semicolon:= Pos(';',OnlineList);
  while (semicolon>0) do
  begin
    u_info:= Copy(OnlineList,1,semicolon-1);
    dot:= Pos(',',u_info);
    nike:= Copy(u_info,1,dot-1);
    ip:= Copy(u_info,dot+1,length(u_info));
    FillChar(u_msg, sizeof(u_msg),#0);
    StrPcopy(u_msg.nikename,nike);
    StrPcopy(u_msg.from_ip,ip);
    New(pmsg);
    pmsg^:= u_msg;
    Node:= TreeView1.Items.AddObject(nil,nike,pmsg);
    Node.ImageIndex:=Index;
    Node.SelectedIndex:= Index;
    Inc(Index);
    delete(OnlineList,1,semicolon);
    semicolon:= Pos(';',OnlineList);
  end;
  result:= True;
end;procedure TfrmMain.TreeView1DblClick(Sender: TObject);
var
  Node:TTreeNode;
  msg :MsgInfo;
  msgtype :TMsgType;
begin
  if not islogin then Exit;
  Node:= TreeView1.Selected;
  with TfrmSend.Create(self) do
  try
    Caption:= '同' + TMsgInfo(Node.Data)^.nikename + '谈话';
    ShowModal;
    if (ModalResult = mrOK) then
    begin
      //发送信息
      FillChar(msg, sizeof(msg), #0);
      msgtype := INFO;
      msg.MsgType := msgtype;
      StrPcopy(msg.nikename, user_nike);
      StrPcopy(msg.to_ip, TMsgInfo(Node.Data)^.from_ip);
      StrPcopy(msg.info, Trim(memSend.Text));
      try
        UDPClient.SendBuffer(server_addr, SERVER_PORT, msg, sizeof(msg));
      except
        on exception do
          MessageDlg('发送信息失败！', mtWarning, [mbOK], 0);
      end;
    end;
  finally
    Free;
  end;
end;end.