unit1.pas

获取鼠标空闲时间实现自动关闭计算机的delphi源代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls, Spin, ExtCtrls,AppEvnts,shellapi;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    StatusBar1: TStatusBar;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    SpinEdit1: TSpinEdit;
    CheckBox1: TCheckBox;
    N1: TMenuItem;
    N2: TMenuItem;
    Timer1: TTimer;
    N3: TMenuItem;
    procedure WMQueryEndSession (var Msg : TWMQueryEndSession);
      message WM_QueryEndSession;
    procedure TrayMenu(Var Msg:TMessage); message WM_USER;
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
    Tray:NOTIFYICONDATA;
    procedure ShowInTray();

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  atom:integer;
  byforce:boolean;
implementation

{$R *.dfm}
function LastInput: integer;
var
  LInput: TLastInputInfo;
begin
  LInput.cbSize := SizeOf(TLastInputInfo);
  GetLastInputInfo(LInput);
  Result := GetTickCount - LInput.dwTime;
end;


{未到自动关机时间，系统要关闭时，截获关机消息
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;
{获得计算机名}
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.Button3Click(Sender: TObject);
begin
  application.Terminate ;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  statusbar1.SimpleText:= Format('System Idle since %d ms', [LastInput]);
  if lastinput>=spinedit1.Value*60000 then
  begin
    if checkbox1.Checked  then byforce:=true else byforce:=false;
    {调用系统的关机提示窗口，默认是强制关机}
    TimedShutDown(getcomputername,'系统将要关机！',30,byforce,false);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  AbortSystemShutdown(pchar(getcomputername));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  {程序退出时，从原子表中移走信息}
  GlobalDeleteAtom(atom);

  {删除托盘中的图标}
  Shell_NotifyIcon(NIM_DELETE,@Tray);

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowWindow(Application.Handle,sw_minimize);
   ShowWindow(Application.Handle,sw_hide);
   ShowInTray;

end;

procedure TForm1.N2Click(Sender: TObject);
begin
  application.Terminate ;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  ShowWindow(Application.Handle,sw_normal);
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.N3Click(Sender: TObject);
begin
  AbortSystemShutdown(pchar(getcomputername));
end;

end.