给你个例子吧，两个单元，拿回去保存编译一下就行了：
program NoFormMsg
uses
SysUtils,
Windows,
Messages,
Classes,
NoFormMsgCls in 'NoFormMsgCls.pas'
var
MyNoForm: TNoFormMsgCls
msg:tagMsg
begin
{ TODO -oUser -cConsole Main : Insert code here }
MyNoForm := TNoFormMsgCls.Crerte
try
while True do begin
PeekMessage(msg, MyNoForm.Handle, 0, 0, PM_NOREMOVE)
if msg.message = WM_CLOSE then break
TranslateMessage(msg)
DispatchMessage(msg)
Sleep(1)
end
finally
MyNoForm.Free
end
end.
unit NoFormMsgCls
interface
uses
Windows, Classes, Messages, SysUtils
type
TNoFormMsgCls = class
private
FHandle:THandle
procedure WndProc(var msg: TMessage)
public
constructor Crerte()
destructor Destroy()override
property Handle: THandle read FHandle
end
implementation
{ TNoFormMsgCls }
constructor TNoFormMsgCls.Crerte
begin
FHandle := Classes.AllocateHWnd(WndProc)
end
destructor TNoFormMsgCls.Destroy
begin
Classes.DeallocateHWnd(FHandle)
inherited
end
procedure TNoFormMsgCls.WndProc(var msg: TMessage)
begin
with Msg do
if Msg = WM_QUERYENDSESSION then begin
if (LParam and ENDSESSION_LOGOFF) >0 then begin
Result := 0
MessageBox(FHandle, '注销啦！', '结束任务', MB_OK)
//PostMessage(FHandle, WM_CLOSE, 0, 0)
end
else begin
Result := 0
MessageBox(FHandle, '关机啦！', '结束任务', MB_OK)
//PostMessage(FHandle, WM_CLOSE, 0, 0)
end
end
else
Result := DefWindowProc(FHandle, Msg, wParam, lParam)
end
end.
源程序： unit AutoShut1interface 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: TObjectvar Key: Char)
procedure WMQueryEndSession (var Msg : TWMQueryEndSession)
message WM_QueryEndSession
procedure FormCreate(Sender: TObject)
procedure FormDestroy(Sender: TObject)
procedure FormCloseQuery(Sender: TObjectvar 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
ifLength(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
varosVerInfo: 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: stringMsg: string
Time: WordForce: BooleanReboot: 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
ifGetOperatingSystem=’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
elseShowWindow(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
ifGetOperatingSystem=’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: TObjectvar Key: Char)
begin
if (key=#13)thenBtn_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: TObjectvar CanClose: Boolean)
begin
{如果已经开始倒记时，禁止关闭程序窗口}
if timer2.Enabled =true then canclose:=false
end
end.
看看 这个是否能用 可以定时关机的
98系统下用exitwindowsex挺好，在2000,XP,NT等已经加强内核安全性的操作系统下关机是不太适合的。对后者，关键是要有管理员权限,如果无权限则不可避免用AdjustTokenPriv
ileges函数然后调用InitiateSystemShutdown关机比较妥当，下面是我调试通过的2000/x
p/Nt自动关机代码，你自己试试。若要扩展到98自己在加判断是98操作系统执行exitwind
owsex的代码。
implementation
{$R *.dfm}
{判断是哪类操作系统，以确定关机方式}
function GetOperatingSystem: Boolean
var osVerInfo: TOSVersionInfo
begin
Result :=False
osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo)
if GetVersionEx(osVerInfo) then
case osVerInfo.dwPlatformId of
VER_PLATFORM_WIN32_NT:
begin
Result := True
end
VER_PLATFORM_WIN32_WINDOWS:
begin
Result := False
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 W2KShutDown(Computer: stringMsg: string
Time: WordForce: BooleanReboot: 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, R
eboot)
end
{重新启动计算机jamesread,在win2000ADVServer测试通过}
procedure TForm1.Button1Click(Sender: TObject)
begin
W2KShutDown('jamesread','shutdown',1,true,true)
end
end.
欢迎分享，转载请注明来源：夏雨云
微信扫一扫
支付宝扫一扫
评论列表（0条）