程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi實現通用的定時自動關機程序

Delphi實現通用的定時自動關機程序

編輯:Delphi

一、問題的提出:運行某任務的計算機,尤其是服務器,如果能實現在無人職守的情況下,到達指定時間時自動關機,那麼將極大地減輕系統管理員的負擔,也會給我們的日常工作帶來很大方便。 

筆者用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下運行成功。

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved