unitservermain.pas

delphi写的基于server和client的聊天源码 有参考意义

{多层数据库程序设计——主界面}
unit Unitservermain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  Menus, ComCtrls,shellapi, ImgList, StdCtrls,adodb,Provider;
const
  WM_WZGLNOTIFY = WM_USER + 100;  //自定义消息
  strNotifyTip = '◆数据应用服务器◆';
  ID_MAIN = 200;
  const
  CM_RESTORE = WM_USER + $1000; {自定义的“恢复”消息}
  WZGL_APP_NAME = 'WZGL_System';
type
  Tfrm_servermain = class(TForm)
    LViewuser: TListView;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    PopupMenu1: TPopupMenu;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    ImageList1: TImageList;
    Luser1: TLabel;
    Lstream1: TLabel;
    Luser: TLabel;
    Lstream: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    function AddIcon(hwnd: HWND): Boolean; //在状态区添加图标
    function RemoveIcon(hwnd: HWND): Boolean; //从状态区移去图标
    procedure Notify(var Msg: TMessage); message WM_WZGLNOTIFY; //自定义消息处理函数
    procedure minimize(sender: Tobject); //定义最小化过程，赋给Application.OnMinimize
    procedure RestoreRequest(var message: TMessage); message CM_RESTORE;
  public
    { Public declarations }
    pmsg,iplist:tstringlist; //消息存放器
    procedure adduser; //增加用户
    procedure divuser; //减少用户
    procedure addstream; //增加访问量;
    procedure addip(ip:string;compname:string); // 增加ip
    procedure divip(ip:string); //减少ip
    procedure tquerysql (querydb:tadoquery;querystring:string);
    procedure remo_exesql(querydb:tadoquery;querystring:string);
    procedure get_clientip(var viewip:string; var viewnames:string;var counts :integer);
    //function netcode:string; //将服务器上的IP封装，便于传递给客户端;
  end;

var
  frm_servermain: Tfrm_servermain;
  nid: NOTIFYICONDATA;
  numcounts,datacounts:integer;
implementation

uses Unitlocatdata, Unitzc;

{$R *.dfm}
///////////////自定义函数/////////////////////////////////
////////////////////////////////////////{处理“恢复”消息}

procedure Tfrm_servermain.RestoreRequest(var message: TMessage);
begin
  if IsIconic(Application.Handle) = True then  //窗体是否最小化
    Application.Restore  //恢复窗体
  else
    Application.BringToFront; //提到前面显示
end;
//在状态区添加图标
function Tfrm_servermain.AddIcon(hwnd: HWND): Boolean;
begin
  nid.cbSize := sizeof(NOTIFYICONDATA);
  nid.Wnd := hwnd;
  nid.uID := iD_MAIN;
  nid.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  nid.uCallbackMessage := WM_WZGLNOTIFY;
  nid.hIcon := LoadIcon(hInstance, 'MAINICON');
  strCopy(nid.szTip, strNotifyTip);
  AddIcon := Shell_NotifyIcon(NIM_ADD, @nid);
end;

//从状态区移去图标
function Tfrm_servermain.RemoveIcon(hwnd: HWND): Boolean;
var
  nid: NOTIFYICONDATA;
begin
  nid.cbSize := sizeof(NOTIFYICONDATA);
  nid.Wnd := hwnd;
  nid.uID := iD_MAIN ;
  nid.uFlags := 0;
  RemoveIcon := Shell_NotifyIcon(NIM_DELETE, @nid);
end;

//自定义消息处理函数
procedure Tfrm_servermain.Notify(var Msg: TMessage);
var
  Pt: TPoint;
begin
  case msg.LParam of
    WM_RBUTTONDOWN:    //当点击右键时,弹出快捷菜单
      begin
        SetForeGroundWindow(nid.wnd);
        GetCursorPos(Pt);
        Popupmenu1.Popup(pt.x, pt.y);
      end;
  end;
end;

//定义最小化过程，赋给Application.OnMinimize;
procedure Tfrm_servermain.minimize(sender: Tobject);
begin
  AddIcon(handle);
  ShowWindow(Application.handle, sw_hide)
end;
////////////////////////////////////////
procedure tfrm_servermain.adduser; //用户增加
begin
  inc(numcounts);
  luser.Caption:=inttostr(numcounts);
end;
procedure tfrm_servermain.divuser; //减少
begin
  numcounts:=numcounts-1;
  luser.Caption:=inttostr(numcounts);
end;
procedure tfrm_servermain.addstream;  //访问量
begin
  inc(datacounts);
  lstream.Caption:=inttostr(datacounts);
end;
procedure tfrm_servermain.addip(ip:string;compname:string);
var
  vlist,vlist2:tlistitem;
begin
  vlist2:=nil;
  vlist2:=lviewuser.FindCaption(0,trim(ip),true,true,true);
  if vlist2=nil then  //没有存在时；
  begin
    vlist:=frm_servermain.LViewuser.Items.Add;
    vlist.Caption:=trim(ip);
    vlist.SubItems.Text:=trim(compname);
    vlist.SubItems.Add(formatdatetime('hh'':''mm'':''ss',now));
  end else
  begin
    divuser;
  end;
end;
procedure tfrm_servermain.divip(ip:string);
var
  vlist:tlistitem;
begin
  vlist:=lviewuser.FindCaption(0,trim(ip),true,true,true);
  lviewuser.Selected:=vlist;
  lviewuser.DeleteSelected;
end;
procedure tfrm_servermain.tquerysql(querydb:tadoquery;querystring:string);
begin
  querydb.close;
  querydb.sql.clear;
  querydb.sql.text:=querystring;
  querydb.open;
end;
procedure tfrm_servermain.remo_exesql(querydb:tadoquery;querystring:string);
begin
  querydb.close;
  querydb.sql.clear;
  querydb.sql.text:=querystring;
  querydb.ExecSQL;
end;
procedure tfrm_servermain.get_clientip(var viewip:string;var viewnames:string;var counts :integer);//取再线用户IP和机器名;
var
  i:integer;
  lists:tlistitem;
begin
  counts:=lviewuser.Items.Count;
  viewip:=viewip+'p'+trim(lviewuser.Items[0].Caption);
  lists:=lviewuser.Items.Item[0];
  viewnames:=viewnames+'p'+trim(lists.SubItems.Strings[0]);
  for i:=1 to lviewuser.Items.Count-1 do
  begin
    viewip:=viewip+'p'+trim(lviewuser.Items[i].Caption);
    lists:=lviewuser.Items.Item[i];
    viewnames:=viewnames+'p'+trim(lists.SubItems.Strings[0]);
  end;
end;
//////////////////////////////////////////////////
procedure Tfrm_servermain.FormCreate(Sender: TObject);
begin
  application.OnMinimize:=minimize;
end;

procedure Tfrm_servermain.N7Click(Sender: TObject);
begin
  if application.MessageBox('关闭应用服务器将影响所有连接到该服务器的客户端不能正常工作，会造成数据丢失，请确定！',pchar(application.Title),mb_iconinformation+mb_yesno)=idyes then
  begin
    application.Terminate;
  end;
end;

procedure Tfrm_servermain.N4Click(Sender: TObject);
begin
  if application.MessageBox('关闭应用服务器将影响所有连接到该服务器的客户端不能正常工作，会造成数据丢失，请确定！',pchar(application.Title),mb_iconinformation+mb_yesno)=idyes then
  begin
    application.Terminate;
  end;
end;

procedure Tfrm_servermain.FormDestroy(Sender: TObject);
begin
  RemoveIcon(handle);
end;

procedure Tfrm_servermain.N5Click(Sender: TObject);
begin
  RemoveIcon(handle);
  self.WindowState:=wsNormal;
  ShowWindow(Application.handle, SW_SHOWNORMAL);
end;

procedure Tfrm_servermain.N2Click(Sender: TObject);
begin
  formzc:=tformzc.Create(self);
  formzc.ShowModal;
end;

procedure Tfrm_servermain.FormShow(Sender: TObject);
begin
   pmsg:=tstringlist.Create;
   iplist:=tstringlist.Create;
end;

end.