unit1.pas

定时关机程序源代码 可以实现定时关机

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,strutils, Graphics,dateutils, Controls, Forms,
  Dialogs,inifiles, ExtCtrls, StdCtrls,registry, ComCtrls, Menus, XPMan;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    GroupBox1: TGroupBox;
    UpDown1: TUpDown;
    Edit1: TEdit;
    UpDown2: TUpDown;
    Edit2: TEdit;
    UpDown3: TUpDown;
    Edit3: TEdit;
    CheckBox1: TCheckBox;
    Bevel1: TBevel;
    CheckBox2: TCheckBox;
    Timer1: TTimer;
    Button1: TButton;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    XPManifest1: TXPManifest;
    N5: TMenuItem;
    N6: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
    procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
    procedure UpDown3Click(Sender: TObject; Button: TUDBtnType);
    procedure CheckBox4Click(Sender: TObject);
    procedure Edit1Click(Sender: TObject);
    procedure Edit2Click(Sender: TObject);
    procedure Edit3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure AdjustToken();
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure settime();
    procedure FormShow(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure wmhotkeyhandle(var msg:tmessage); message wm_hotkey;
    procedure N5Click(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
  p5,p7:integer;
  shuttime:string;
  tishi,kaiji:boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;


{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var myini:tinifile;filename:string;volume:dword;w1:word;hold:string;found:hwnd;

begin
hold:=application.Title;
application.Title:='am1025shut'+inttostr(hinstance);
found:=findwindow(nil,pchar(hold));
application.Title:=hold;
if found<>0 then
 begin
 //form1.Show;
 //application.BringToFront;
  //showwindow(found,sw_normal);
  showmessage('已有一实例运行,Alt+S显示.');
  application.Terminate;

 end;

Filename:=ExtractFilePath(Paramstr(0))+'info.ini';
myini:=Tinifile.create(filename);
self.CheckBox1.Checked:=myini.Readbool('shutdown','shut',true);
self.CheckBox2.Checked:=myini.Readbool('autorun','run',true);
self.Edit1.Text:=myini.ReadString('time','houre','22');
self.Edit2.Text:=myini.ReadString('time','minute','45');
self.CheckBox3.Checked:=myini.Readbool('hint','tishi',true);
self.CheckBox4.Checked:=myini.Readbool('minisource','open',true);
self.CheckBox5.Checked:=myini.Readbool('text','hotkey',true);
myini.Free;

self.StatusBar1.Panels[0].Text:=datetimetostr(now);
self.settime;
if shuttime='' then
  shuttime:='22:45:00';
  tishi:=true;

 if strtotime(shuttime)<=time() then
   begin
    checkbox1.Checked:=false;
   end;
 p7:=GlobalAddAtom(pchar('s'))-$C000;
registerhotkey(handle,p7,mod_Alt,$53);
if checkbox5.Checked then
 begin
p5:=GlobalAddAtom(pchar('t'))-$C000;
registerhotkey(handle,p5,mod_Alt,$54);
 end;
end;

procedure tform1.wmhotkeyhandle(var msg:tmessage);
var a:pchar;b,c:string;
begin
if (msg.LParamHi=$53) and (msg.LParamLo=mod_alt) then
begin
msg.Result:=1;
//self.Caption:='ok';
form1.Show;
application.BringToFront;
end;
if (msg.LParamHi=$54) and (msg.LParamLo=mod_alt) then
begin
msg.Result:=1;
 a:=StrAlloc(255);
 getsystemdirectory(a,255);
 b:=self.Caption;
 self.Caption:=a+'\notepad.exe';
 c:=self.Caption;
 self.Caption:=b;
//getsystemdirectory
 winexec(pchar(c),sw_shownormal);
end;

end;
procedure TForm1.Timer1Timer(Sender: TObject);
var myt:string;form2:tform2;
begin
//self.Caption:=shuttime;
self.StatusBar1.Panels[0].Text:=datetimetostr(now);
 if self.CheckBox1.Checked then
  begin
  try
   if strtotime(shuttime)<=time() then
   begin
   try
     unregisterhotkey(handle,p7);
   DeleteAtom(p7);
    //self.Caption:='ok';
    finally
    self.AdjustToken;
   ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF,0);
   end;
   end;
  except

  end;
  end;
  if checkbox3.Checked then
  begin
  if tishi then
   begin
    if checkbox1.Checked then
     begin
      try
       myt:=datetimetostr(incminute(strtodatetime('2003-10-25 '+shuttime),-5));
       myt:=rightstr(trim(myt),8);
       if strtotime(myt)<=time() then
        begin
         tishi:=false;
         //showmessage('警告:本计算机将在'+shuttime+'关闭!');
         try
         form2:=tform2.Create(self);
         form2.ShowModal;
         finally
         form2.Free;
         end;


        end;

      except
      end;
     end;
   end;
  end;
end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
  edit1.Text:=inttostr(self.UpDown1.Position);
end;

procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
edit2.Text:=inttostr(self.UpDown2.Position);
end;

procedure TForm1.UpDown3Click(Sender: TObject; Button: TUDBtnType);
begin
edit3.Text:=inttostr(self.UpDown3.Position);
end;

procedure TForm1.CheckBox4Click(Sender: TObject);
begin
if self.CheckBox4.Checked then
timer1.Interval:=60000
else
timer1.Interval:=1000;
end;

procedure TForm1.Edit1Click(Sender: TObject);
begin
self.Edit1.SelectAll;
end;

procedure TForm1.Edit2Click(Sender: TObject);
begin
self.Edit2.SelectAll;
end;

procedure TForm1.Edit3Click(Sender: TObject);
begin
self.Edit3.SelectAll;
end;

procedure TForm1.Button1Click(Sender: TObject);
var myini:tinifile; filename:string; reg:tregistry; path:string;
begin
self.settime;
//postmessage(self.Handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
Filename:=ExtractFilePath(Paramstr(0))+'info.ini';
myini:=Tinifile.create(filename);
 myini.WriteBool('shutdown','shut',checkbox1.Checked);
 if (edit1.Text<>'') and (edit2.Text<>'') then
  begin
   myini.WriteString('time','houre',edit1.Text);
   myini.WriteString('time','minute',edit2.Text);
  end;
myini.WriteBool('autorun','run',checkbox2.Checked);
myini.WriteBool('hint','tishi',checkbox3.Checked);
myini.WriteBool('minisource','open',checkbox4.Checked);
myini.WriteBool('text','hotkey',checkbox5.Checked);
myini.Free;
 reg:=tregistry.Create;
 reg.RootKey:=HKEY_LOCAL_MACHINE;
 try
 if reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false) then
 begin
 path:=application.ExeName;
  if checkbox2.Checked then
  reg.WriteString('autoshutdown',path)
  else
  begin
   if reg.ValueExists('autoshutdown') then
    reg.DeleteValue('autoshutdown');
  end;



 end;
 finally
 reg.Free;
 end;
 self.Hide;
   //self.Caption:=shuttime;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
 if not((key in ['0'..'9',#8])) then
  begin
   key:=#0;
   edit1.Clear;
   edit1.SetFocus;
  end;

end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
 if not((key in ['0'..'9',#8])) then
  begin
   key:=#0;
   edit2.Clear;
   edit2.SetFocus;
  end;

end;

procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
 if not((key in ['0'..'9',#8])) then
  begin
   key:=#0;
   edit3.Clear;
   edit3.SetFocus;

  end;
end;
 procedure TForm1.AdjustToken();
var
  hdlProcessHandle : Cardinal;
  hdlTokenHandle : Cardinal;
  tmpLuid : Int64;
  tkpPrivilegeCount : Int64;
  tkp : TOKEN_PRIVILEGES;
  tkpNewButIgnored : TOKEN_PRIVILEGES;
  lBufferNeeded : Cardinal;
  Privilege : array[0..0] of _LUID_AND_ATTRIBUTES;
begin
         hdlProcessHandle := GetCurrentProcess;
         OpenProcessToken(hdlProcessHandle,
                         (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY),
                          hdlTokenHandle);

         // Get the LUID for shutdown privilege.
         LookupPrivilegeValue('', 'SeShutdownPrivilege', tmpLuid);
         Privilege[0].Luid := tmpLuid;
         Privilege[0].Attributes := SE_PRIVILEGE_ENABLED;
         tkp.PrivilegeCount := 1;   // One privilege to set
         tkp.Privileges[0] := Privilege[0];
         // Enable the shutdown privilege in the access token of this
         // process.
         AdjustTokenPrivileges(hdlTokenHandle,
                               False,
                               tkp,
                               Sizeof(tkpNewButIgnored),
                               tkpNewButIgnored,
                               lBufferNeeded);

 end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var myini:tinifile; filename:string; reg:tregistry; path:string;
begin
Filename:=ExtractFilePath(Paramstr(0))+'info.ini';
myini:=Tinifile.create(filename);
 myini.WriteBool('shutdown','shut',checkbox1.Checked);
 if (edit1.Text<>'') and (edit2.Text<>'') then
  begin
   myini.WriteString('time','houre',edit1.Text);
   myini.WriteString('time','minute',edit2.Text);
  end;
myini.WriteBool('autorun','run',checkbox2.Checked);
myini.WriteBool('hint','tishi',checkbox3.Checked);
myini.WriteBool('minisource','open',checkbox4.Checked);
myini.Free;
 reg:=tregistry.Create;
 reg.RootKey:=HKEY_LOCAL_MACHINE;
 try
 if reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false) then
 begin
 path:=application.ExeName;
  if checkbox2.Checked then
  reg.WriteString('autoshutdown',path)
  else
  begin
   if reg.ValueExists('autoshutdown') then
    reg.DeleteValue('autoshutdown');
  end;



 end;
 finally
 reg.Free;
 end;
end;

procedure tform1.settime();
begin
if (self.Edit1.Text<>'') and (edit2.Text<>'') and (edit3.Text<>'') then
 begin
  if length(trim(edit1.Text))=1 then
   shuttime:='0'+edit1.Text else
   shuttime:=edit1.Text;
 //self.Caption:=shuttime;
 if length(trim(edit2.Text))=1 then
   shuttime:=shuttime+':'+'0'+edit2.Text else
   shuttime:=shuttime+':'+edit2.Text;

    if length(trim(edit3.Text))=1 then
   shuttime:=shuttime+':'+'0'+edit3.Text else
   shuttime:=shuttime+':'+edit3.Text;
 end;
 //else
 //showmessage('时间设置错误!');
end;

procedure TForm1.FormShow(Sender: TObject);
begin
if checkbox4.Checked then
  timer1.Interval:=60000;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
self.Hide;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
showmessage('版权所有@张伟'+chr(13)+chr(10)+'Email:[e-mail]'+chr(13)+chr(10)+'网址:http://amsite.1a.cn');
end;

procedure TForm1.N4Click(Sender: TObject);
begin
self.Close;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if (checkbox1.Checked) and (strtotime(shuttime)<=time()) then
begin
//self.Caption:=shuttime;
 checkbox1.Checked:=false;
 showmessage('设定的时间比现在时间早!');
 
 
 end;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
if MessageBox(Handle, '确定要关机吗?', '关机', MB_ICONQUESTION or MB_OKCANCEL or MB_DEFBUTTON2)=1 then
  begin
  self.AdjustToken;
  ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF,0);

 //self.Caption:='good';
  end;
end;
procedure TForm1.CheckBox5Click(Sender: TObject);
begin
if checkbox5.Checked then
 begin
 try
p5:=GlobalAddAtom(pchar('t'))-$C000;
registerhotkey(handle,p5,mod_Alt,$54);
 except
 end;
 end
 else
 begin
   try
     unregisterhotkey(handle,p5);
   DeleteAtom(p5);

   except

   end;

 end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
  unregisterhotkey(handle,p5);
   DeleteAtom(p5);
     unregisterhotkey(handle,p7);
   DeleteAtom(p7);

except
end;
end;

end.