Delphi實(shí)現(xiàn)通用的定時自動關(guān)機(jī)程序

字號:

一、問題的提出:運(yùn)行某任務(wù)的計算機(jī),尤其是服務(wù)器,如果能實(shí)現(xiàn)在無人職守的情況下,到達(dá)指定時間時自動關(guān)機(jī),那么將極大地減輕系統(tǒng)管理員的負(fù)擔(dān),也會給我們的日常工作帶來很大方便?!?BR>    筆者用Delphi開發(fā)的這個定時自動關(guān)機(jī)程序,適用于目前兩類的Windows系列操作系統(tǒng):從Windows 95/98/Me到Windows NT/2000/XP?!?BR>    二、程序的功能有: 
    1.用戶自己設(shè)定關(guān)機(jī)時間,通過自定義函數(shù)IsValidTime()判斷用戶輸入的時間是否有效?!?BR>    2.定時強(qiáng)制自動關(guān)機(jī):對于windows 95/98/Me,直接調(diào)用API函數(shù)ExitWindowsEx()關(guān)機(jī)。對于NT/2000/XP,需要取得計算機(jī)名,獲得關(guān)機(jī)特權(quán)后,才能關(guān)機(jī):首先調(diào)用OpenProcessToken()函數(shù)得到存取令牌的句柄,然后調(diào)用AdjustTokenPrivileges()函數(shù)來使能該特權(quán)。Win32API定義了一組字符串常量來標(biāo)識不同的特權(quán),如關(guān)機(jī)特權(quán)是 ’SeShutdownPrivilege’?!?BR>    3.到達(dá)設(shè)定的關(guān)機(jī)時間時,延時30秒,以便用戶保存文件,或取消關(guān)機(jī)。兩類操作系統(tǒng)都顯示倒記時,對于windows 95/98/Me,只通過程序界面顯示;對于NT/2000/XP,將調(diào)用系統(tǒng)的倒記時界面顯示。 
    4.為了不占用任務(wù)欄的空間,程序顯示在托盤中。右鍵單擊托盤中的圖標(biāo),將顯示快捷菜單?!?BR>    5.如果未到設(shè)定的關(guān)機(jī)時間,系統(tǒng)要關(guān)閉,該程序能截獲關(guān)機(jī)消息,由用戶選擇是否關(guān)機(jī)。原理是:當(dāng)用戶關(guān)閉Windows時,系統(tǒng)會發(fā)送給各應(yīng)用程序一個消息wm_queryendsession,告訴各應(yīng)用程序要關(guān)機(jī)了,如果反饋回來的消息值為0,就不能關(guān)機(jī)。因此,截獲wm_queryendsession,并反饋回0,就大功告成了?!?BR>    6.在內(nèi)存中只運(yùn)行本程序的一個實(shí)例。原理是:利用Windows 的全局原子表信息來實(shí)現(xiàn)此功能。Windows 的全局原子表可以被當(dāng)前所有應(yīng)用程序訪問,它一共可包含37 項內(nèi)容。程序運(yùn)行時,首先檢查在表中有無本程序的信息,如有,則提示后退出。如沒有,則在表中增加該程序的信息。程序最后退出時要從表中移走信息以便程序能再運(yùn)行?!  ?BR>    四、源程序: 
    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; 
    {關(guān)機(jī)延遲時間} 
    TimeDelay:integer; 
    atom:integer; 
    implementation 
    {$R *.dfm} 
    {未到自動關(guān)機(jī)時間,系統(tǒng)要關(guān)閉時,截獲關(guān)機(jī)消息 
    wm_queryendsession,讓用戶決定是否關(guān)機(jī)} 
    procedure TForm1.WMQueryEndSession (var Msg : TWMQueryEndSession); 
    begin 
    if MessageDlg(’真的要關(guān)閉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; 
    {判斷是哪類操作系統(tǒng),以確定關(guān)機(jī)方式} 
    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; 
    {獲得計算機(jī)名} 
    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; 
    {定時關(guān)機(jī)函數(shù) ,各參數(shù)的意義如下: 
    Computer: 計算機(jī)名;Msg:顯示的提示信息; 
    Time:時間延遲; Force:是否強(qiáng)制關(guān)機(jī); 
    Reboot: 是否重啟動} 
    function TimedShutDown(Computer: string; Msg: string; 
    Time: Word; Force: Boolean; Reboot: Boolean): Boolean; 
    var 
    rl: Cardinal; 
    hToken: Cardinal; 
    tkp: TOKEN_PRIVILEGES; 
    begin 
    {獲得用戶關(guān)機(jī)特權(quán),僅對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:=’定時關(guān)機(jī)’; 
    Shell_NotifyIcon(NIM_ADD,@Tray); 
    End; 
    {右鍵單擊托盤中的圖標(biāo),顯示快捷菜單} 
    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); 
    {兩個時間相等,計算機(jī)將在TimeDelay秒內(nèi)強(qiáng)制關(guān)機(jī)} 
    if edit1.text=edit2.Text then 
    Begin 
    TimeDelay:=30; 
    timer1.Enabled:=False; 
    if GetOperatingSystem=’Windows NT/2000/XP’ then 
    begin 
    {調(diào)用系統(tǒng)的關(guān)機(jī)提示窗口,只限于Windows NT/2000/XP。} 
    TimedShutDown(getcomputername, ’系統(tǒng)將要關(guān)機(jī)!’, 
    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_MOST,Left,Top,Width,Height, 
              SWP_NOACTIVATE); 
    end; 
    end; 
    end; 
    procedure TForm1.Timer2Timer(Sender: TObject); 
    begin 
    btn_abort.Enabled :=true; 
    label3.Caption :=’離關(guān)機(jī)時間還有’+inttostr(timedelay)+’秒。’; 
    if timedelay>0 then timedelay:=timedelay-1 
    else 
    begin 
     timer2.Enabled :=false; 
     {強(qiáng)制Windows 95/98/98SE/Me關(guān)機(jī)} 
     ExitWindowsEx(EWX_SHUTDOWN+EWX_FORCE,0); 
     end; 
    end; 
    {通過控件PopupMenu1定義的快捷菜單,包括"設(shè)置關(guān)機(jī)時間"和"退出"?!?BR>    PopupMenu1的AutoPopup為False,下面是"設(shè)置關(guān)機(jī)時間"的代碼} 
    procedure TForm1.TimeSetClick(Sender: TObject); 
    begin 
    {設(shè)置本程序窗口位于最頂層} 
    SetWindowPos(Handle,HWND_MOST,Left,Top,Width,Height, 
              SWP_NOACTIVATE); 
    ShowWindow(Application.Handle,SW_NORMAL); 
    edit2.SetFocus ; 
    edit2.SelectAll ; 
    end; 
    {快捷菜單中"退出"的代碼} 
    procedure TForm1.ExitClick(Sender: TObject); 
    begin 
    {如果已經(jīng)開始倒記時,禁止退出,而是顯示程序窗口} 
    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 :=’提示:關(guān)機(jī)時間格式 HH:MM’; 
    if timer1.Enabled =false then timer1.Enabled :=true; 
    {關(guān)機(jī)時間設(shè)置有效,程序?qū)@示在托盤中,無效則提示。} 
    if IsValidTime(edit2.Text) then 
     begin 
     ShowWindow(Application.Handle,sw_minimize); 
     ShowWindow(Application.Handle,sw_hide); 
     ShowInTray; 
     end 
    else 
     showmessage(’提示:時間格式錯誤,’+chr(13)+ 
     ’請輸入正確的關(guān)機(jī)時間 HH:MM?!?; 
    end; 
    {取消關(guān)機(jī)按鈕} 
    procedure TForm1.Btn_AbortClick(Sender: TObject); 
    begin 
    if  GetOperatingSystem=’Windows NT/2000/XP’ then 
     {對于Windows NT/2000/XP,取消關(guān)機(jī)} 
     begin 
     AbortSystemShutdown(pchar(getcomputername)); 
     end; 
     {停止倒記時} 
    if timer2.Enabled =true then timer2.Enabled :=false; 
    btn_abort.Enabled :=false; 
    end; 
    {輸入關(guān)機(jī)時間后,可直接按回車} 
    procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char); 
    begin 
    if (key=#13)  then  Btn_OK.Click; 
    end; 
    {搜尋系統(tǒng)原子表看是否程序已運(yùn)行} 
    procedure TForm1.FormCreate(Sender: TObject); 
    begin 
    {如果沒運(yùn)行則在表中增加信息 } 
    if GlobalFindAtom(’PROGRAM_RUNNING’) = 0 then 
     atom := GlobalAddAtom(’PROGRAM_RUNNING’) 
    else begin 
     {如果程序已運(yùn)行則顯示信息然后退出 } 
     MessageDlg(’程序已經(jīng)在運(yùn)行!’,mtWarning,[mbOK],0); 
     Halt; 
    end; 
    end; 
    procedure TForm1.FormDestroy(Sender: TObject); 
    begin 
    {程序退出時,從原子表中移走信息} 
    GlobalDeleteAtom(atom); 
    {刪除托盤中的圖標(biāo)} 
    Shell_NotifyIcon(NIM_DELETE,@Tray); 
    end; 
    procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
    begin 
    {如果已經(jīng)開始倒記時,禁止關(guān)閉程序窗口} 
    if timer2.Enabled =true then canclose:=false; 
    end; 
    end. 
    五、說明:本程序在Windows XP下,用Delphi 6.0開發(fā),在Windows 95/98/Me和Windows NT/2000/XP下運(yùn)行成功。