!!!求救:一段98/2k下定时关机的代码报错,解决给200分!

djfdd 2004-03-24 10:46:24
/////一段定时关机的代码,但我编译运行后出现运行错误,fORM第4行'变量未定义',请教??
'---FORM中-----------------------
Option Explicit

Dim uFlags As Long
Private Sub Form_Load()
Timer1.Enabled = False
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
If Time > CDate("0:00:00") And Time < CDate("8:00:00") Then
AdjustTokenPrivilegesForNT
ExitWindowsEx uFlags, 4
ExitWindowsEx EWX_FORCE, 4
End If
End Sub

'------BAS中----------------
Option Explicit
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

'ExitWindowsExµÄ²ÎÊýuflags£¬ÓÐËĸö¶ÔÓ¦Öµ£¬·Ö±ðÊÇ£º

Public Const EWX_LOGOFF = 0 'Í˳ö(×¢Ïú)
Public Const EWX_SHUTDOWN = 1 '¹Ø»ú
Public Const EWX_REBOOT = 2 'ÖØÆô¶¯
Public Const EWX_FORCE = 4 'Ç¿Öƹػú£¬¼´²»Í¨ÖªÏÖÔڻӦÓóÌÐòÈÃÆäÏÈ×ÔÎҹرÕ

Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Const ANYSIZE_ARRAY = 1

Type LUID
lowpart As Long
highpart As Long
End Type

Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long

'Õâ¸öº¯Êý¾ÍÊÇÓÃÓÚNT¹Ø»úÖÐʹÓõÄ
Sub AdjustTokenPrivilegesForNT()

Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long

hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or _
TOKEN_QUERY), hdlTokenHandle

LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
tkp.PrivilegeCount = 1
tkp.Privileges(0).pLuid = tmpLuid
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

AdjustTokenPrivileges hdlTokenHandle, False, tkp, _
Len(tkpNewButIgnored), tkpNewButIgnored, _
lBufferNeeded
End Sub

...全文
61 13 打赏 收藏 转发到动态 举报
写回复
用AI写文章
13 条回复
切换为时间正序
请发表友善的回复…
发表回复
lsm0959 2004-03-29
  • 打赏
  • 举报
回复
其实用不着那么麻烦,就是因为一个EMX_POWEROFF=8,这个常数msdn里没有
dragonscorpico 2004-03-28
  • 打赏
  • 举报
回复
看如下代码,98/2000/XP下测试通过。

Option Explicit
'关机、重启模块
Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const EWX_POWEROFF = 8
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Const ANYSIZE_ARRAY = 1
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32s = 0


Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function SetSystemPowerState Lib "kernel32" (ByVal fSuspend As Long, ByVal fForce As Long) As Long

Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Type LUID
LowPart As Long
HighPart As Long
End Type
Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Public ReBootWindows As Boolean
Public ShutDownWindows As Boolean
Public LogOffWindows As Boolean


Public Function IsWinNT() As Integer
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = myOS.dwPlatformId
End Function
'set the shut down privilege for the current application
Public Sub EnableShutDown()
Dim hProc As Long
Dim hToken As Long
Dim mLUID As LUID
Dim mPriv As TOKEN_PRIVILEGES
Dim mNewPriv As TOKEN_PRIVILEGES
hProc = GetCurrentProcess()
OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
mPriv.PrivilegeCount = 1
mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
mPriv.Privileges(0).pLuid = mLUID
' enable shutdown privilege for the current application
AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub
' Shut Down NT
Public Sub ShutDownNT(Force As Boolean)
Dim Ret As Long
Dim flags As Long
flags = EWX_SHUTDOWN + EWX_POWEROFF

Call IsWinNT

If Force Then
flags = flags + EWX_FORCE
End If

Select Case IsWinNT
Case 2
EnableShutDown
ExitWindowsEx flags, 0
Case 1
Ret = ExitWindowsEx(EWX_SHUTDOWN + EWX_POWEROFF Or EWX_FORCE, 0)
End Select
End Sub
'Restart NT
Public Sub RebootNT(Force As Boolean)
Dim Ret As Long
Dim flags As Long
flags = EWX_REBOOT

Call IsWinNT

If Force Then
flags = flags + EWX_FORCE
End If

Select Case IsWinNT
Case 2
EnableShutDown
ExitWindowsEx flags, 0
Case 1
Ret = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)
End Select
End Sub
'Log off the current user
Public Sub LogOffNT(Force As Boolean)
Dim Ret As Long
Dim flags As Long
flags = EWX_LOGOFF

Call IsWinNT

If Force Then
flags = flags + EWX_FORCE
End If

Select Case IsWinNT
Case 2
EnableShutDown
ExitWindowsEx flags, 0
Case 1
Ret = ExitWindowsEx(EWX_LOGOFF Or EWX_FORCE, 0)
End Select
End Sub


sakurako 2004-03-26
  • 打赏
  • 举报
回复
需要进程令牌权限,请看(转载)

Public Const EWX_FORCE = 4
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Const ANYSIZE_ARRAY = 1

Type LUID
lowpart As Long
highpart As Long
End Type


Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type


Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type


Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long


Sub AdjustTokenPrivilegesForNT()
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long

hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
tkp.PrivilegeCount = 1
tkp.Privileges(0).pLuid = tmpLuid
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded

End Sub

'关机时用下面的代码
Private Sub Command1_Click()
AdjustTokenPrivilegesForNT
ExitWindowsEx uFlags, 0
End Sub

good luck!!!!!!!!!
flc 2004-03-26
  • 打赏
  • 举报
回复
学习
ufonba 2004-03-25
  • 打赏
  • 举报
回复
我也遇到这样的问题,只能够注销XP,并不能关闭他!
online 2004-03-25
  • 打赏
  • 举报
回复
需要完整代码的给我来信
或者去掉osinfo类即可
Dim mOS As OSInfo

Private Sub Command1_Click()

Set mOS = New OSInfo
Dim sname As String
sname = mOS.OSName
If sname = "Windows 2000" Then
AdjustToken
Call ExitWindowsEx(EWX_POWEROFF, 0)
Else
iAns = MsgBox("Are you sure you want to exit windows?", vbQuestion Or _
vbYesNo, "Exit Windows")
If iAns = vbYes Then
rVal = ExitWindowsEx(EWX_SHUTDOWN, 0)
End If
End If
End Sub



'以下代码放在一个标准摸块中:
Option Explicit
Public Declare Function SetSystemPowerState Lib "KERNEL32" (ByVal fSuspend As Long, ByVal fForce As Long) As Long
Enum HowExitConst
EWX_FORCE = 4 ' 强制关机
EWX_LOGOFF = 0 ' 登出
EWX_REBOOT = 2 ' 重开机
EWX_SHUTDOWN = 1 ' 关机
EWX_POWEROFF = 8 '关闭电源

End Enum

Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const ANYSIZE_ARRAY = 1
Public Type LUID
lowpart As Long
highpart As Long
End Type

Public Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Public Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long
Public Declare Function GetCurrentProcess Lib "KERNEL32" () As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias _
"LookupPrivilegeValueA" (ByVal lpSystemName As String, _
ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" _
(ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _
PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Public Declare Function OpenProcessToken Lib "advapi32.dll" _
(ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long
'**************WIN2000安全机制关机*************************
Public Sub AdjustToken()

Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long

hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), _
hdlTokenHandle

LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
tkp.PrivilegeCount = 1
tkp.Privileges(0).pLuid = tmpLuid
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), _
tkpNewButIgnored, lBufferNeeded
End Sub

djfdd 2004-03-24
  • 打赏
  • 举报
回复
我做了,现在只能注销,不能关机,几个参数我都试了,为什么??/
华芸智森 2004-03-24
  • 打赏
  • 举报
回复
如果是这样.你从左边的工具箱中拖一个时钟控件到FORM中即可.
华芸智森 2004-03-24
  • 打赏
  • 举报
回复
这说明你的窗体中没有Timer1控件.
online 2004-03-24
  • 打赏
  • 举报
回复
你的form上有没有timer控件????
djfdd 2004-03-24
  • 打赏
  • 举报
回复
陈老师,还是我的问题啊,上面的代码也是你教我的,我取消了,现在报错为'Timer1.Enabled = False ,要求对象'
RyuOut 2004-03-24
  • 打赏
  • 举报
回复
AdjustTokenPrivilegesForNT

这句话是没有意义的
华芸智森 2004-03-24
  • 打赏
  • 举报
回复

Option Explicit
取消看看??

1,486

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧