⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit_auto_shut.pas

📁 编程练习:自动关机小助手
💻 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 + -