vb自动关机程序

最新推荐文章于 2021-06-21 22:27:24 发布

goushaoping04

最新推荐文章于 2021-06-21 22:27:24 发布

阅读量447

点赞数

分类专栏： VB 文章标签： vb token function timer string query

本文链接：https://blog.csdn.net/goushaoping04/article/details/5625189

版权

VB 专栏收录该内容

8 篇文章 0 订阅

订阅专栏

Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private closeTime As String

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 Form_Load()
Dim fso As New FileSystemObject
    Dim ts As TextStream
    Dim txt, iniFilePath As String
    iniFilePath = App.Path & "/" & "system.ini"
     If fso.FileExists(iniFilePath) Then
       Set ts = fso.OpenTextFile(App.Path & "/" & "system.ini")
       closeTime = ts.ReadLine
       ts.Close
       Set ts = Nothing
       If Len(Trim(closeTime)) = 0 Then
            Set ts = fso.CreateTextFile(iniFilePath)
            ts.WriteLine "23:00"
            ts.Close
            Set ts = Nothing
            closeTime = "23:00"
       End If
    Else
       Set ts = fso.CreateTextFile(iniFilePath)
       ts.WriteLine "23:00"
       ts.Close
       closeTime = "23:00"
    End If
    Timer1.Enabled = True
    Timer1.Interval = 1000
End Sub

Private Sub Timer1_Timer()
If Trim(Hour(Now) & ":" & Minute(Now)) = Trim(closeTime) Then
AdjustTokenPrivilegesForNT '在95/98中调用没作用，但为了和NT兼容，写上无妨
ExitWindowsEx EWX_SHUTDOWN, 0
End If
End Sub

'模块

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