现在的位置: 首页 > 综合 > 正文

自动关机(Delphi)

2018年02月06日 ⁄ 综合 ⁄ 共 6282字 ⁄ 字号 评论关闭

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.
 

抱歉!评论已关闭.