userver.pas

开发的一个仿QQ的UDP聊天的程序源代码

unit uServer;

interface

uses
  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.