📄 unit_auto_shut.pas
字号:
unit Unit_Auto_Shut;
interface
uses
Windows, Messages, SysUtils, StdCtrls, Buttons, Controls, Menus, DateUtils,
AppEvnts, Classes, ExtCtrls, Variants, Graphics, Forms, Dialogs, shellapi,
ComCtrls, Registry;
type
Tfrm_Auto_Shut = class(TForm)
Timer1: TTimer;
Timer2: TTimer;
ApplicationEvents1: TApplicationEvents;
PopupMenu1: TPopupMenu;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
btn_OK: TBitBtn;
btn_Abort: TBitBtn;
mi_Set_Time: TMenuItem;
mi_Close: TMenuItem;
DateTimePicker1: TDateTimePicker;
DateTimePicker2: TDateTimePicker;
StatusBar1: TStatusBar;
btn_Min: TBitBtn;
btn_Auto_Run: TBitBtn;
brn_Exit: TBitBtn;
BitBtn3: TBitBtn;
procedure Timer1Timer(Sender: TObject);
procedure TrayMenu(var Msg:TMessage); message WM_USER;
procedure WMQueryEndSession(var Msg:TWMQueryEndSession);
procedure Timer2Timer(Sender: TObject);
procedure mi_Set_TimeClick(Sender: TObject);
procedure btn_OKClick(Sender: TObject);
procedure btn_AbortClick(Sender: TObject);
procedure Edit2KeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure DateTimePicker2KeyPress(Sender: TObject; var Key: Char);
procedure brn_ExitClick(Sender: TObject);
procedure mi_CloseClick(Sender: TObject);
procedure btn_MinClick(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btn_Auto_RunClick(Sender: TObject);
private
{ Private declarations }
Tray:NOTIFYICONDATA;
procedure ShowInTray;
public
{ Public declarations }
end;
var
frm_Auto_Shut: Tfrm_Auto_Shut;
atom:integer;
FBool_Time_is_Set:Boolean;
implementation
uses Unit_About;
{$R *.dfm}
{未到自动关机时间,系统要关闭时,截获关机消息wm_queryendsession,让用户决定是否关机}
procedure Tfrm_Auto_Shut.WMQueryEndSession(var Msg:TWMQueryEndSession);
begin
if MessageDlg('真的要关闭Windows吗?',mtConfirmation,[mbYes,mbNo],0)=mrNo then
Msg.Result:=0
else
Msg.Result:=1;
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 Tfrm_Auto_Shut.Timer1Timer(Sender: TObject);
var
h0,m0,s0:word;
h1,m1,s1,ms1:word;
h2,m2,s2,ms2:word;
sh0,sm0,ss0:string;
mStr_Time_is_Up:string;//关机延迟时间
begin
DateTimePicker1.DateTime:=Now;{两个时间相等,计算机将在TimeDelay秒内强制关机}
DecodeTime(DateTimePicker1.Time,h1,m1,s1,ms1);
DecodeTime(DateTimePicker2.Time,h2,m2,s2,ms2);
if s2<s1 then
begin
if m2=0 then
begin
if h2=0 then
begin
h2:=24;
end;
h2:=h2-1;
m2:=60;
end;
m2:=m2-1;
s2:=s2+60;
end;
s0:=s2-s1;
if m2<m1 then
begin
if h2=0 then
begin
h2:=24;
end;
h2:=h2-1;
m2:=m2+60;
end;
m0:=m2-m1;
if h2<h1 then
begin
if h2=0 then h2:=24;
h2:=h2+24;
end;
h0:=h2-h1;
if h0<10 then sh0:='0'+IntToStr(h0) else sh0:=IntToStr(h0);
if m0<10 then sm0:='0'+IntToStr(m0) else sm0:=IntToStr(m0);
if s0<10 then ss0:='0'+IntToStr(s0) else ss0:=IntToStr(s0);
mStr_Time_is_Up:=sh0+':'+sm0+':'+ss0;
if (not btn_OK.Enabled) then
begin
if (h0=0)and(m0=0)and(s0=0) then
begin
//关机时间到,显示主界面,请示关机剩余时间
SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_NOACTIVATE);
application.restore;
SetForegroundWindow(Handle);
// showwindow(application.handle,SW_HIDE);//隐藏任务栏//OnCreate: setwindowlong
FBool_Time_is_Set:=false;
timer1.Enabled:=False;
timer2.Enabled:=true;
DateTimePicker2.Time:=IncSecond(DateTimePicker2.Time,30);
end
else
begin
label3.Caption:='离自动关机还有:'+#13#10+'['+mStr_Time_is_Up+']';
end;
end
else
begin
label3.Caption:='未启动自动关机';
end;
end;
{右键单击托盘中的图标,显示快捷菜单}
procedure Tfrm_Auto_Shut.TrayMenu(var Msg: TMessage);
var
X,Y:Tpoint;
J,K:Integer;
begin
GetCursorPos(X);
GetCursorPos(Y);
J:=X.X;
K:=Y.Y;
with Msg do
begin
if (lparam=WM_LBUTTONDBLCLK) then
begin
mi_Set_Time.Click;
end
else
if (lparam=wm_rbuttondown) then
begin
PopupMenu1.Popup(J,K);
end;
end;
end;
{窗体最小化后,显示在托盘中}
procedure Tfrm_Auto_Shut.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:='自动关机小助手V1';
Shell_NotifyIcon(NIM_ADD,@Tray);
end;
procedure Tfrm_Auto_Shut.Timer2Timer(Sender: TObject);
var
h0,m0,s0:word;
h1,m1,s1,ms1:word;
h2,m2,s2,ms2:word;
sh0,sm0,ss0:string;
mStr_Time_is_Up:string;//关机延迟时间
begin
DateTimePicker1.DateTime:=Now;{两个时间相等,计算机将在TimeDelay秒内强制关机}
DecodeTime(DateTimePicker1.Time,h1,m1,s1,ms1);
DecodeTime(DateTimePicker2.Time,h2,m2,s2,ms2);
if s2<s1 then
begin
if m2=0 then
begin
if h2=0 then
begin
h2:=24;
end;
h2:=h2-1;
m2:=60;
end;
m2:=m2-1;
s2:=s2+60;
end;
s0:=s2-s1;
if m2<m1 then
begin
if h2=0 then
begin
h2:=24;
end;
h2:=h2-1;
m2:=m2+60;
end;
m0:=m2-m1;
if h2<h1 then
begin
if h2=0 then h2:=24;
h2:=h2+24;
end;
h0:=h2-h1;
if h0<10 then sh0:='0'+IntToStr(h0) else sh0:=IntToStr(h0);
if m0<10 then sm0:='0'+IntToStr(m0) else sm0:=IntToStr(m0);
if s0<10 then ss0:='0'+IntToStr(s0) else ss0:=IntToStr(s0);
mStr_Time_is_Up:=sh0+':'+sm0+':'+ss0;
if (h0=0)and(m0=0)and(s0=0) then//提醒时间到,执行自动关机命令
begin
timer2.Enabled:=false;
if GetOperatingSystem='Windows NT/2000/XP' then
begin
{调用系统的关机提示窗口,只限于Windows NT/2000/XP。}
TimedShutDown(getcomputername,'系统将要关机!',30,true,false);//系统强行关闭,不重启
FBool_Time_is_Set:=true;
end;
if GetOperatingSystem='Windows 95/98/98SE/Me' then
begin
{强制Windows 95/98/98SE/Me关机}
ExitWindowsEx(EWX_SHUTDOWN+EWX_FORCE,0);
end;
end
else
begin
label3.Caption:='离自动关机还有:'+#13#10+'['+mStr_Time_is_Up+']';
timer2.Enabled:=true;
FBool_Time_is_Set:=false;
end
end;
{通过控件PopupMenu1定义的快捷菜单,包括"设置关机时间"和"退出"。
PopupMenu1的AutoPopup为False
下面是"设置关机时间"的代码}
procedure Tfrm_Auto_Shut.mi_Set_TimeClick(Sender: TObject);
begin
if not frm_Auto_Shut.Visible then
begin
show;
SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_NOACTIVATE);//设置本程序窗口位于最顶层
application.restore;
SetForegroundWindow(Handle);
// showwindow(application.handle,SW_HIDE);//OnCreate: setwindowlong
if DateTimePicker2.Enabled then DateTimePicker2.SetFocus;
end
else
begin
ShowInTray;//在系统托盘中显示图标
showwindow(application.handle,SW_MINIMIZE);//最小化
showwindow(application.handle,SW_HIDE);//隐藏任务栏//OnCreate: setwindowlong
hide;
end;
end;
procedure Tfrm_Auto_Shut.btn_OKClick(Sender: TObject);
begin
DateTimePicker2.Enabled:=false;
btn_Ok.Enabled:=false;
btn_abort.Enabled:=true;
if timer1.Enabled=false then timer1.Enabled:=true;
end;
procedure Tfrm_Auto_Shut.btn_AbortClick(Sender: TObject);
begin
if (FBool_Time_is_Set)and(GetOperatingSystem='Windows NT/2000/XP') then
begin
AbortSystemShutdown(pchar(getcomputername));{对于Windows NT/2000/XP,取消关机}
end;
timer1.Enabled:=true;
timer2.Enabled:=false;
btn_abort.Enabled:=false;
btn_Ok.Enabled:=true;
DateTimePicker2.Enabled:=true;
label3.Caption:='未启动自动关机';
end;
procedure Tfrm_Auto_Shut.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
if (key=#13) then Btn_OK.Click;
end;
{搜寻系统原子表看是否程序已运行}
procedure Tfrm_Auto_Shut.FormCreate(Sender: TObject);
//var
// mTime:TTime;
begin
{如果没运行则在表中增加信息}
if GlobalFindAtom('Auto_Shut_Mr_Wang')=0 then
begin
atom:=GlobalAddAtom('Auto_Shut_Mr_Wang');
end
else
begin
{如果程序已运行则显示信息然后退出}
if MessageDlg('程序已经在运行!'+#13#10+'退出请单击[yes],否则请单击[no]。',mtWarning,[mbYes,mbno],0)=mrYes then
begin
Halt;
end
else
begin
atom:=GlobalAddAtom('Auto_Shut_Mr_Wang');
GlobalDeleteAtom(atom);
end;
end;
FBool_Time_is_Set:=false;
btn_OK.Enabled:=true;
btn_Abort.Enabled:=false;
DateTimePicker1.Time:=GetTime;
// mTime:=GetTime;
// if ((mTime>=StrToTime('1:30:00')) and (mTime<=StrToTime('12:00:00'))) then
// begin
// DateTimePicker2.Time:=StrToTime('12:30:00');
// end
// else
// if ((mTime>StrToTime('12:00:00')) and (mTime<=StrToTime('22:00:00'))) then
// begin
DateTimePicker2.Time:=StrToTime('22:30:00');
// end;
caption:='自动关机小助手V1.0'+' 启动时间:'+FormatDateTime('yyyy年mm月dd日hh:nn:ss',now);
ShowInTray;//在系统托盘中显示图标
setwindowlong(application.handle,gwl_exstyle,ws_ex_toolwindow); //让窗口在运行时不在任务栏上出现按钮
end;
procedure Tfrm_Auto_Shut.FormDestroy(Sender: TObject);
begin
GlobalDeleteAtom(atom);//程序退出时,从原子表中移走信息
Shell_NotifyIcon(NIM_DELETE,@Tray);//删除托盘中的图标
end;
procedure Tfrm_Auto_Shut.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
canclose:=btn_OK.Enabled;//如果已经开始倒记时,禁止关闭程序窗口
end;
procedure Tfrm_Auto_Shut.DateTimePicker2KeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
btn_OK.Click;
end;
end;
procedure Tfrm_Auto_Shut.brn_ExitClick(Sender: TObject);
begin
{如果已经开始倒记时,禁止退出,而是显示程序窗口}
if btn_OK.Enabled=true then
begin
Application.Terminate;
end
else
begin
if MessageDlg('已经运行自动关机!'+#13#10+'确认退出请单击[yes],否则请单击[no]。',mtwarning,[mbyes,mbno],0)=mryes then
begin
btn_OK.Enabled:=false;
Application.Terminate;
end
else
begin
mi_Set_Time.Click;//显示主界面
end;
end;
end;
procedure Tfrm_Auto_Shut.mi_CloseClick(Sender: TObject);
begin
brn_Exit.Click;
end;
procedure Tfrm_Auto_Shut.btn_MinClick(Sender: TObject);
begin
ShowInTray;//在系统托盘中显示图标
showwindow(application.handle,SW_MINIMIZE);//最小化
showwindow(application.handle,SW_HIDE);//隐藏任务栏//OnCreate: setwindowlong
hide;
end;
procedure Tfrm_Auto_Shut.BitBtn3Click(Sender: TObject);
begin
AboutBox:=TAboutBox.Create(self);
try
AboutBox.ShowModal;
finally
AboutBox.Free;
end;
end;
procedure Tfrm_Auto_Shut.FormShow(Sender: TObject);
var
tempreg:TRegistry;
mStr_Application_ExeName:string;
begin
mStr_Application_ExeName:=Application.ExeName;
tempreg:=TRegistry.Create;
tempreg.RootKey:=HKEY_LOCAL_MACHINE;
tempreg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
if tempreg.ValueExists('自动关机小助手V1.0') then
//判断是否已经设置[开机自动运行]
begin
btn_Auto_Run.Caption:='撤消自动运行';
DateTimePicker2.Enabled:=false;
btn_Ok.Enabled:=false;
btn_abort.Enabled:=true;
if timer1.Enabled=false then timer1.Enabled:=true;
end
else
begin
btn_Auto_Run.Caption:='设置自动运行';
end;
tempreg.Closekey;
tempreg.Free;
if DateTimePicker2.Enabled then DateTimePicker2.SetFocus;
end;
procedure Tfrm_Auto_Shut.btn_Auto_RunClick(Sender: TObject);
var
tempreg:TRegistry;
mStr_Application_ExeName:string;
begin
mStr_Application_ExeName:=Application.ExeName;
tempreg:=TRegistry.Create;
tempreg.RootKey:=HKEY_LOCAL_MACHINE;
tempreg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
if tempreg.ValueExists('自动关机小助手V1.0') then
//判断是否已经设置[开机自动运行]
//如果已经设置,则取消[开机自动运行]
//否则设置[开机自动运行]
begin
if tempreg.DeleteValue('自动关机小助手V1.0') then
begin
btn_Auto_Run.Caption:='设置自动运行';
showmessage('已经取消[开机自动运行]');
end;
end
else
begin
tempreg.WriteString('自动关机小助手V1.0',Application.ExeName);
btn_Auto_Run.Caption:='撤消自动运行';
showmessage('已经设置[开机自动运行]');
end;
tempreg.Closekey;
tempreg.Free;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -