Delphi 定时关机详细解释版

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.