下载本文示例代码
一、问题的提出:运行某任务的计算机，尤其是服务器，如果能实现在无人职守的情况下，到达指定时间时自动关机，那么将极大地减轻系统管理员的负担，也会给我们的日常工作带来很大方便。 笔者用Delphi开发的这个定时自动关机程序，适用于目前两类的Windows系列操作系统：从Windows 95/98/Me到Windows NT/2000/XP。 二、程序的功能有： 1.用户自己设定关机时间，通过自定义函数IsValidTime()判断用户输入的时间是否有效。 2.定时强制自动关机：对于windows 95/98/Me,直接调用API函数ExitWindowsEx()关机。对于NT/2000/XP,需要取得计算机名，获得关机特权后，才能关机：首先调用OpenProcessToken()函数得到存取令牌的句柄，然后调用AdjustTokenPrivileges()函数来使能该特权。Win32API定义了一组字符串常量来标识不同的特权，如关机特权是 ’SeShutdownPrivilege’。 3.到达设定的关机时间时，延时30秒，以便用户保存文件，或取消关机。两类操作系统都显示倒记时，对于windows 95/98/Me，只通过程序界面显示；对于NT/2000/XP，将调用系统的倒记时界面显示。 4.为了不占用任务栏的空间，程序显示在托盘中。右键单击托盘中的图标，将显示快捷菜单。 5.如果未到设定的关机时间，系统要关闭，该程序能截获关机消息，由用户选择是否关机。原理是：当用户关闭Windows时，系统会发送给各应用程序一个消息wm_queryendsession，告诉各应用程序要关机了，如果反馈回来的消息值为0，就不能关机。因此，截获wm_queryendsession，并反馈回0，就大功告成了。 6.在内存中只运行本程序的一个实例。原理是：利用Windows 的全局原子表信息来实现此功能。Windows 的全局原子表可以被当前所有应用程序访问，它一共可包含37 项内容。程序运行时，首先检查在表中有无本程序的信息，如有，则提示后退出。如没有，则在表中增加该程序的信息。程序最后退出时要从表中移走信息以便程序能再运行。 四、源程序：
unit AutoShut1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Menus,AppEvnts,shellapi; type TForm1 = class(TForm) Timer1: TTimer; Timer2: TTimer; ApplicationEvents1: TApplicationEvents; PopupMenu1: TPopupMenu; Edit1: TEdit; Edit2: TEdit; Label1: TLabel; Label2: TLabel; Label3: TLabel; Btn_OK: TButton; Btn_Abort: TButton; procedure Timer1Timer(Sender: TObject); procedure TrayMenu(Var Msg:TMessage); message WM_USER; procedure TimeSetClick(Sender: TObject); procedure ExitClick(Sender: TObject); procedure Btn_OKClick(Sender: TObject); procedure Btn_AbortClick(Sender: TObject); procedure Timer2Timer(Sender: TObject); procedure Edit2KeyPress(Sender: TObject; var Key: Char); procedure WMQueryEndSession (var Msg : TWMQueryEndSession); message WM_QueryEndSession; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); private { Private declarations } Tray:NOTIFYICONDATA; procedure ShowInTray(); public { Public declarations } end; var Form1: TForm1; P,Ti1:Pchar; Flags:Longint; i:integer; {关机延迟时间} TimeDelay:integer; atom:integer; implementation {$R *.dfm} {未到自动关机时间，系统要关闭时，截获关机消息 wm_queryendsession，让用户决定是否关机} procedure TForm1.WMQueryEndSession (var Msg : TWMQueryEndSession); begin if MessageDlg(’真的要关闭Windows吗？’,mtConfirmation,[mbYes,mbNo], 0) = mrNo then Msg.Result := 0 else Msg.Result := 1; end; {判断时间S格式是否是有效} function IsValidTime(s:string):bool; begin if Length(s)<>5 then IsValidTime:=False else begin if(s[1]<’0’)or(s[1]>’2’)or(s[2]<’0’)or (s[2]>’9’) or (s[3] <> ’:’) or (s[4]<’0’) or (s[4]>’5’) or (s[5]<’0’) or (s[5]>’9’)then IsValidTime:=False else IsValidTime:=True; end; end; {判断是哪类操作系统，以确定关机方式} function GetOperatingSystem: string; var osVerInfo: TOSVersionInfo; begin Result :=’’; osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); if GetVersionEx(osVerInfo) then case osVerInfo.dwPlatformId of VER_PLATFORM_WIN32_NT: begin Result := ’Windows NT/2000/XP’ end; VER_PLATFORM_WIN32_WINDOWS: begin Result := ’Windows 95/98/98SE/Me’; end; end; end; {获得计算机名} function GetComputerName: string; var buffer: array[0..MAX_COMPUTERNAME_LENGTH 1] of Char; Size: Cardinal; begin Size := MAX_COMPUTERNAME_LENGTH 1; Windows.GetComputerName(@buffer, Size); Result := strpas(buffer); end; {定时关机函数 ，各参数的意义如下： Computer: 计算机名;Msg:显示的提示信息; Time:时间延迟; Force:是否强制关机; Reboot: 是否重启动} function TimedShutDown(Computer: string; Msg: string; Time: Word; Force: Boolean; Reboot: Boolean): Boolean; var rl: Cardinal; hToken: Cardinal; tkp: TOKEN_PRIVILEGES; begin {获得用户关机特权，仅对Windows NT/2000/XP} OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken); if LookupPrivilegeValue(nil, ’SeShutdownPrivilege’, tkp.Privileges[0].Luid) then begin tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; tkp.PrivilegeCount := 1; AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl); end; Result := InitiateSystemShutdown(PChar(Computer), PChar(Msg), Time, Force, Reboot) end; {窗体最小化后，显示在托盘中} procedure tform1.ShowInTray; Begin Tray.cbSize:=sizeof(Tray); Tray.Wnd:=Self.Handle; Tray.uFlags:=NIF_ICON NIF_MESSAGE NIF_TIP; Tray.uCallbackMessage:=WM_USER; Tray.hIcon:=application.Icon.Handle ; Tray.szTip:=’定时关机’; Shell_NotifyIcon(NIM_ADD,@Tray); End; {右键单击托盘中的图标，显示快捷菜单} procedure Tform1.TrayMenu(var Msg:TMessage); var X,Y:Tpoint; J,K:Integer; Begin GetCursorPos(X); GetCursorPos(Y); J:=X.X; K:=Y.Y; if Msg.LParam=WM_RBUTTONDOWN then PopupMenu1.Popup(J,K); End; procedure TForm1.Timer1Timer(Sender: TObject); begin Edit1.Text:=FormatDateTime(’hh:mm’, Now); {两个时间相等，计算机将在TimeDelay秒内强制关机} if edit1.text=edit2.Text then Begin TimeDelay:=30; timer1.Enabled:=False; if GetOperatingSystem=’Windows NT/2000/XP’ then begin {调用系统的关机提示窗口，只限于Windows NT/2000/XP。} TimedShutDown(getcomputername, ’系统将要关机！’, TimeDelay, true, false); btn_abort.Enabled :=true; timer2.Enabled :=true; end; if GetOperatingSystem=’Windows 95/98/98SE/Me’ then begin timer2.Enabled :=true; {在顶层显示本程序的窗口，显示时间倒记时} Application.Restore; SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width,Height, SWP_NOACTIVATE); end; end; end; procedure TForm1.Timer2Timer(Sender: TObject); begin btn_abort.Enabled :=true; label3.Caption :=’离关机时间还有’ inttostr(timedelay) ’秒。’; if timedelay>0 then timedelay:=timedelay-1 else begin timer2.Enabled :=false; {强制Windows 95/98/98SE/Me关机} ExitWindowsEx(EWX_SHUTDOWN EWX_FORCE,0); end; end; {通过控件PopupMenu1定义的快捷菜单，包括"设置关机时间"和"退出"。 PopupMenu1的AutoPopup为False，下面是"设置关机时间"的代码} procedure TForm1.TimeSetClick(Sender: TObject); begin {设置本程序窗口位于最顶层} SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width,Height, SWP_NOACTIVATE); ShowWindow(Application.Handle,SW_NORMAL); edit2.SetFocus ; edit2.SelectAll ; end; {快捷菜单中"退出"的代码} procedure TForm1.ExitClick(Sender: TObject); begin {如果已经开始倒记时，禁止退出，而是显示程序窗口} if Timer2.Enabled=false then begin Application.Terminate; end else ShowWindow(Application.Handle,SW_NORMAL); end; {确定按钮} procedure TForm1.Btn_OKClick(Sender: TObject); begin btn_abort.Enabled :=false; label3.Caption :=’提示：关机时间格式 HH:MM’; if timer1.Enabled =false then timer1.Enabled :=true; {关机时间设置有效，程序将显示在托盘中，无效则提示。} if IsValidTime(edit2.Text) then begin ShowWindow(Application.Handle,sw_minimize); ShowWindow(Application.Handle,sw_hide); ShowInTray; end else showmessage(’提示：时间格式错误，’ chr(13) ’请输入正确的关机时间 HH:MM。’); end; {取消关机按钮} procedure TForm1.Btn_AbortClick(Sender: TObject); begin if GetOperatingSystem=’Windows NT/2000/XP’ then {对于Windows NT/2000/XP,取消关机} begin AbortSystemShutdown(pchar(getcomputername)); end; {停止倒记时} if timer2.Enabled =true then timer2.Enabled :=false; btn_abort.Enabled :=false; end; {输入关机时间后，可直接按回车} procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char); begin if (key=#13) then Btn_OK.Click; end; {搜寻系统原子表看是否程序已运行} procedure TForm1.FormCreate(Sender: TObject); begin {如果没运行则在表中增加信息 } if GlobalFindAtom(’PROGRAM_RUNNING’) = 0 then atom := GlobalAddAtom(’PROGRAM_RUNNING’) else begin {如果程序已运行则显示信息然后退出 } MessageDlg(’程序已经在运行!’,mtWarning,[mbOK],0); Halt; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin {程序退出时，从原子表中移走信息} GlobalDeleteAtom(atom); {删除托盘中的图标} Shell_NotifyIcon(NIM_DELETE,@Tray); end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin {如果已经开始倒记时，禁止关闭程序窗口} if timer2.Enabled =true then canclose:=false; end; end. 五、说明：本程序在Windows XP下，用Delphi 6.0开发，在Windows 95/98/Me和Windows NT/2000/XP下运行成功。
一、问题的提出:运行某任务的计算机，尤其是服务器，如果能实现在无人职守的情况下，到达指定时间时自动关机，那么将极大地减轻系统管理员的负担，也会给我们的日常工作带来很大方便。 笔者用Delphi开发的这个定时自动关机程序，适用于目前两类的Windows系列操作系统：从Windows 95/98/Me到Windows NT/2000/XP。 二、程序的功能有： 1.用户自己设定关机时间，通过自定义函数IsValidTime()判断用户输入的时间是否有效。 2.定时强制自动关机：对于windows 95/98/Me,直接调用API函数ExitWindowsEx()关机。对于NT/2000/XP,需要取得计算机名，获得关机特权后，才能关机：首先调用OpenProcessToken()函数得到存取令牌的句柄，然后调用AdjustTokenPrivileges()函数来使能该特权。Win32API定义了一组字符串常量来标识不同的特权，如关机特权是 ’SeShutdownPrivilege’。 3.到达设定的关机时间时，延时30秒，以便用户保存文件，或取消关机。两类操作系统都显示倒记时，对于windows 95/98/Me，只通过程序界面显示；对于NT/2000/XP，将调用系统的倒记时界面显示。 4.为了不占用任务栏的空间，程序显示在托盘中。右键单击托盘中的图标，将显示快捷菜单。 5.如果未到设定的关机时间，系统要关闭，该程序能截获关机消息，由用户选择是否关机。原理是：当用户关闭Windows时，系统会发送给各应用程序一个消息wm_queryendsession，告诉各应用程序要关机了，如果反馈回来的消息值为0，就不能关机。因此，截获wm_queryendsession，并反馈回0，就大功告成了。 6.在内存中只运行本程序的一个实例。原理是：利用Windows 的全局原子表信息来实现此功能。Windows 的全局原子表可以被当前所有应用程序访问，它一共可包含37 项内容。程序运行时，首先检查在表中有无本程序的信息，如有，则提示后退出。如没有，则在表中增加该程序的信息。程序最后退出时要从表中移走信息以便程序能再运行。 四、源程序：
unit AutoShut1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Menus,AppEvnts,shellapi; type TForm1 = class(TForm) Timer1: TTimer; Timer2: TTimer; ApplicationEvents1: TApplicationEvents; PopupMenu1: TPopupMenu; Edit1: TEdit; Edit2: TEdit; Label1: TLabel; Label2: TLabel; Label3: TLabel; Btn_OK: TButton; Btn_Abort: TButton; procedure Timer1Timer(Sender: TObject); procedure TrayMenu(Var Msg:TMessage); message WM_USER; procedure TimeSetClick(Sender: TObject); procedure ExitClick(Sender: TObject); procedure Btn_OKClick(Sender: TObject); procedure Btn_AbortClick(Sender: TObject); procedure Timer2Timer(Sender: TObject); procedure Edit2KeyPress(Sender: TObject; var Key: Char); procedure WMQueryEndSession (var Msg : TWMQueryEndSession); message WM_QueryEndSession; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); private { Private declarations } Tray:NOTIFYICONDATA; procedure ShowInTray(); public { Public declarations } end; var Form1: TForm1; P,Ti1:Pchar; Flags:Longint; i:integer; {关机延迟时间} TimeDelay:integer; atom:integer; implementation {$R *.dfm} {未到自动关机时间，系统要关闭时，截获关机消息 wm_queryendsession，让用户决定是否关机} procedure TForm1.WMQueryEndSession (var Msg : TWMQueryEndSession); begin if MessageDlg(’真的要关闭Windows吗？’,mtConfirmation,[mbYes,mbNo], 0) = mrNo then Msg.Result := 0 else Msg.Result := 1; end; {判断时间S格式是否是有效} function IsValidTime(s:string):bool; begin if Length(s)<>5 then IsValidTime:=False else begin if(s[1]<’0’)or(s[1]>’2’)or(s[2]<’0’)or (s[2]>’9’) or (s[3] <> ’:’) or (s[4]<’0’) or (s[4]>’5’) or (s[5]<’0’) or (s[5]>’9’)then IsValidTime:=False else IsValidTime:=True; end; end; {判断是哪类操作系统，以确定关机方式} function GetOperatingSystem: string; var osVerInfo: TOSVersionInfo; begin Result :=’’; osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); if GetVersionEx(osVerInfo) then case osVerInfo.dwPlatformId of VER_PLATFORM_WIN32_NT: begin Result := ’Windows NT/2000/XP’ end; VER_PLATFORM_WIN32_WINDOWS: begin Result := ’Windows 95/98/98SE/Me’; end; end; end; {获得计算机名} function GetComputerName: string; var buffer: array[0..MAX_COMPUTERNAME_LENGTH 1] of Char; Size: Cardinal; begin Size := MAX_COMPUTERNAME_LENGTH 1; Windows.GetComputerName(@buffer, Size); Result := strpas(buffer); end; {定时关机函数 ，各参数的意义如下： Computer: 计算机名;Msg:显示的提示信息; Time:时间延迟; Force:是否强制关机; Reboot: 是否重启动} function TimedShutDown(Computer: string; Msg: string; Time: Word; Force: Boolean; Reboot: Boolean): Boolean; var rl: Cardinal; hToken: Cardinal; tkp: TOKEN_PRIVILEGES; begin {获得用户关机特权，仅对Windows NT/2000/XP} OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken); if LookupPrivilegeValue(nil, ’SeShutdownPrivilege’, tkp.Privileges[0].Luid) then begin tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; tkp.PrivilegeCount := 1; AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl); end; Result := InitiateSystemShutdown(PChar(Computer), PChar(Msg), Time, Force, Reboot) end; {窗体最小化后，显示在托盘中} procedure tform1.ShowInTray; Begin Tray.cbSize:=sizeof(Tray); Tray.Wnd:=Self.Handle; Tray.uFlags:=NIF_ICON NIF_MESSAGE NIF_TIP; Tray.uCallbackMessage:=WM_USER; Tray.hIcon:=application.Icon.Handle ; Tray.szTip:=’定时关机’; Shell_NotifyIcon(NIM_ADD,@Tray); End; {右键单击托盘中的图标，显示快捷菜单} procedure Tform1.TrayMenu(var Msg:TMessage); var X,Y:Tpoint; J,K:Integer; Begin GetCursorPos(X); GetCursorPos(Y); J:=X.X; K:=Y.Y; if Msg.LParam=WM_RBUTTONDOWN then PopupMenu1.Popup(J,K); End; procedure TForm1.Timer1Timer(Sender: TObject); begin Edit1.Text:=FormatDateTime(’hh:mm’, Now); {两个时间相等，计算机将在TimeDelay秒内强制关机} if edit1.text=edit2.Text then Begin TimeDelay:=30; timer1.Enabled:=False; if GetOperatingSystem=’Windows NT/2000/XP’ then begin {调用系统的关机提示窗口，只限于Windows NT/2000/XP。} TimedShutDown(getcomputername, ’系统将要关机！’, TimeDelay, true, false); btn_abort.Enabled :=true; timer2.Enabled :=true; end; if GetOperatingSystem=’Windows 95/98/98SE/Me’ then begin timer2.Enabled :=true; {在顶层显示本程序的窗口，显示时间倒记时} Application.Restore; SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width,Height, SWP_NOACTIVATE); end; end; end; procedure TForm1.Timer2Timer(Sender: TObject); begin btn_abort.Enabled :=true; label3.Caption :=’离关机时间还有’ inttostr(timedelay) ’秒。’; if timedelay>0 then timedelay:=timedelay-1 else begin timer2.Enabled :=false; {强制Windows 95/98/98SE/Me关机} ExitWindowsEx(EWX_SHUTDOWN EWX_FORCE,0); end; end; {通过控件PopupMenu1定义的快捷菜单，包括"设置关机时间"和"退出"。 PopupMenu1的AutoPopup为False，下面是"设置关机时间"的代码} procedure TForm1.TimeSetClick(Sender: TObject); begin {设置本程序窗口位于最顶层} SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width,Height, SWP_NOACTIVATE); ShowWindow(Application.Handle,SW_NORMAL); edit2.SetFocus ; edit2.SelectAll ; end; {快捷菜单中"退出"的代码} procedure TForm1.ExitClick(Sender: TObject); begin {如果已经开始倒记时，禁止退出，而是显示程序窗口} if Timer2.Enabled=false then begin Application.Terminate; end else ShowWindow(Application.Handle,SW_NORMAL); end; {确定按钮} procedure TForm1.Btn_OKClick(Sender: TObject); begin btn_abort.Enabled :=false; label3.Caption :=’提示：关机时间格式 HH:MM’; if timer1.Enabled =false then timer1.Enabled :=true; {关机时间设置有效，程序将显示在托盘中，无效则提示。} if IsValidTime(edit2.Text) then begin ShowWindow(Application.Handle,sw_minimize); ShowWindow(Application.Handle,sw_hide); ShowInTray; end else showmessage(’提示：时间格式错误，’ chr(13) ’请输入正确的关机时间 HH:MM。’); end; {取消关机按钮} procedure TForm1.Btn_AbortClick(Sender: TObject); begin if GetOperatingSystem=’Windows NT/2000/XP’ then {对于Windows NT/2000/XP,取消关机} begin AbortSystemShutdown(pchar(getcomputername)); end; {停止倒记时} if timer2.Enabled =true then timer2.Enabled :=false; btn_abort.Enabled :=false; end; {输入关机时间后，可直接按回车} procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char); begin if (key=#13) then Btn_OK.Click; end; {搜寻系统原子表看是否程序已运行} procedure TForm1.FormCreate(Sender: TObject); begin {如果没运行则在表中增加信息 } if GlobalFindAtom(’PROGRAM_RUNNING’) = 0 then atom := GlobalAddAtom(’PROGRAM_RUNNING’) else begin {如果程序已运行则显示信息然后退出 } MessageDlg(’程序已经在运行!’,mtWarning,[mbOK],0); Halt; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin {程序退出时，从原子表中移走信息} GlobalDeleteAtom(atom); {删除托盘中的图标} Shell_NotifyIcon(NIM_DELETE,@Tray); end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin {如果已经开始倒记时，禁止关闭程序窗口} if timer2.Enabled =true then canclose:=false; end; end. 五、说明：本程序在Windows XP下，用Delphi 6.0开发，在Windows 95/98/Me和Windows NT/2000/XP下运行成功。
下载本文示例代码
Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序Delphi实现通用的定时自动关机程序
