uclient.pas

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

unit uClient;

interface

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