关闭

Delphi实现通用的定时自动关机程序

614人阅读 评论(0) 收藏 举报
分类:
一、问题的提出:运行某任务的计算机,尤其是服务器,如果能实现在无人职守的情况下,到达指定时间时自动关机,那么将极大地减轻系统管理员的负担,也会给我们的日常工作带来很大方便。 

  笔者用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下运行成功。
0
0

猜你在找
【直播】机器学习&数据挖掘7周实训--韦玮
【套餐】系统集成项目管理工程师顺利通关--徐朋
【直播】3小时掌握Docker最佳实战-徐西宁
【套餐】机器学习系列套餐(算法+实战)--唐宇迪
【直播】计算机视觉原理及实战--屈教授
【套餐】微信订阅号+服务号Java版 v2.0--翟东平
【直播】机器学习之矩阵--黄博士
【套餐】微信订阅号+服务号Java版 v2.0--翟东平
【直播】机器学习之凸优化--马博士
【套餐】Javascript 设计模式实战--曾亮
查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:330037次
    • 积分:6030
    • 等级:
    • 排名:第4156名
    • 原创:0篇
    • 转载:1054篇
    • 译文:0篇
    • 评论:0条
    文章分类