servereatunit.pas

东华休闲山庄洗浴、餐饮、客房管理系统

unit ServerEatUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinSkinData, ExtCtrls, StdCtrls, Registry, TLHelp32, ShellAPI;

type
  TServerEatForm = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Timer1: TTimer;
    SkinData1: TSkinData;
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
    Datetime:tdatetime;//当前时间
    SoftPath,SoftName:string;//服务器端应用程序所在目录、服务器端应用程序名称
    function IFOpenServer:boolean;//是否已打开scktsrvr服务
    procedure CloseServer;//关闭scktsrvr服务
    procedure GetClientCount(index:integer);//获取当前已连接服务器端的客户端个数
  end;

var
  ServerEatForm: TServerEatForm;

implementation

{$R *.dfm}

function TServerEatForm.IFOpenServer:boolean;
var
  FProcessEntry32:TProcessEntry32;
  FSnapshotHandle:THandle;
  ProcessHndle:THandle;
  ProcessID:integer;
  temp:string;
  Ret:BOOL;
begin
  result:=false;
  FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
  Ret:=Process32First(FSnapshotHandle,FProcessEntry32);
  ProcessID:=FProcessEntry32.th32ProcessID;
  while Ret do
    begin
      temp:=ExtractFileName(FProcessEntry32.szExeFile);
      if temp='scktsrvr.exe' then
        begin
          result:=true;
          break;
        end;
      Ret:=Process32Next(FSnapshotHandle,FProcessEntry32);
    end;
  CloseHandle(FSnapshotHandle);
  ProcessHndle:=OpenProcess(PROCESS_VM_WRITE,false,ProcessID);
  CloseHandle(ProcessHndle);
end;

procedure TServerEatForm.CloseServer;
var
  FProcessEntry32:TProcessEntry32;
  FSnapshotHandle:THandle;
  ProcessHndle:THandle;
  ProcessID:integer;
  temp:string;
  flag:hwnd;
  Ret:BOOL;
begin
  FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
  Ret:=Process32First(FSnapshotHandle,FProcessEntry32);
  ProcessID:=FProcessEntry32.th32ProcessID;
  while Ret do
    begin
      temp:=ExtractFileName(FProcessEntry32.szExeFile);
      if temp='scktsrvr.exe' then
        begin
          flag:=openprocess(process_terminate,false,FProcessEntry32.th32ProcessID);
          terminateprocess(flag,0);
        end;
      Ret:=Process32Next(FSnapshotHandle,FProcessEntry32);
    end;
  CloseHandle(FSnapshotHandle);
  ProcessHndle:=OpenProcess(PROCESS_VM_WRITE,false,ProcessID);
  CloseHandle(ProcessHndle);
end;

procedure TServerEatForm.GetClientCount(index:integer);
begin
  Label8.Caption:=inttostr(strtoint(Label8.Caption)+index);
end;

procedure TServerEatForm.FormCreate(Sender: TObject);
begin
  if not IFOpenServer then
    ShellExecute(Handle,'open','scktsrvr.exe',nil,nil,SW_SHOWNORMAL);
  SoftName:=ExtractFileName(application.ExeName);
  SoftPath:=ExtractFilePath(application.ExeName);
  SkinData1.SkinFile:=SoftPath+'skin.skn';
  SkinData1.Active:=true;
  Datetime:=now;
  Label2.Caption:=datetimetostr(Datetime);
  Label8.Caption:='0';
  WindowState:=wsMinimized;
end;

procedure TServerEatForm.Timer1Timer(Sender: TObject);
begin
  Label4.Caption:=datetimetostr(now);
  Label6.Caption:=timetostr(now-Datetime);
end;

procedure TServerEatForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if strtoint(Label8.Caption)=0 then
    begin
      CloseServer;
      Action := caFree;
    end
  else
    begin
      showmessage('当前已有'+Label8.Caption+'个客户端正在连接服务器端，不可以关闭！');
      Action := caNone;
    end;
end;

procedure TServerEatForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=VK_ESCAPE then
    close;
end;

end.