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.
分享到:
相关推荐
delphi 定时关机软件源代码 20100614
用Delphi XE2编写的定时关机程序,包含源代码。
Delphi 定时关机源码:自己写的一个程序,主要解决了不同操作NT系统下都可用的关机系统。 本机时间更新、定时关机、延时关机等功能。 默认密码为123456.
用delphi 开发的定时关机程序,有托盘显示,让你关机更随意!压缩包内含有源码,可根据自己的需求自由更改。 谨以此小程序献给我亲爱的艳艳,谢谢大家的支持。
自己用Delphi写的一个定时关机的程序, 如果好用,可以发邮件到我邮箱: fazls@126.com
delphi定时关机,包含源码,有需求请下载。
这是一个定时关机的小程序,由于每天晚上要定时关机,就随便写了一个,,呵呵,大家有用的着的,可以下载下来
Delphi 定时关机小程序
实现定时关机,如果不想关机,立即可以取消。本程序是使用DELPHI实现的,请大家参考!谢谢!
我是小黑 621844217 一直挺关注delphi方面的东西、 昨天看到一个朋友 出的一个关机软件的制作 那个在xp下 不起作用 不知道其他人有没有这个情况 我来改进下 代码我就不一句一句写了 之前写好了 直接...
这个程序用了vclskin皮肤控件,可以定时关机、开机启动、隐藏界面等。
delphi 定时关机软件v2.0 20101001.rar delphi 定时关机软件v2.0 20101001.rar
Delphi代码实现的定时关机程序,使用控件HookDll.dll,配置文件为INI格式,在INI内设置定时关机的时间即可,程序打开后会自动这些设置。
Delphi编写定时关机小程序,含有Delphi源代码
时钟助手,Delphi定时关机、提醒、闹钟…..rar
这个源码主程序是delphi开发的。DLL是VC开发的。都是源码。时间取的是美国大学服务器的时间。不论你如果改电脑本地时间,软件都会修正为正确的时间。
功能:定时关机、重启、注销、待机、修眠。 采用MASM32编写,界面比较简单,体积也小。 文件说明符 : E:\masm32\works\ClosePC\ClosePC.exe 属性 : A--- 数字签名:否 PE文件:是 语言 : 中文(中国) 文件版本 : 0.0....
较好的定时关机程序(附主要源码,Delphi VCL版); 本程序完全使用VCL编程,如Flat, VCLSkin,WaterEffect,CoolTrayIcon,等,方便并且稳定,只不过体积大了一点。 程序写的很烂,如有不妥之处或有待改进之处,欢迎...