克拉玛依金海湾宾馆:VB：自动关机源码

Private qdtime                               '变量保存计时起点
Private imglft As Integer                     '退出图标左坐标初值
'下面为关机的 WIMDOWS API 函数声明
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Enum HowExitConst
        EWX_FORCE = 4     '强制关机
        EWX_LOGOFF = 0     '注销
        EWX_REBOOT = 2     '重开机
        EWX_SHUTDOWN = 1   '可关机98 但在2000下关机最后出现“ 现在可以安全关机”的问题
        EWX_POWEROFF = 8   '可以关闭Windows NT/2000/XP:计算机的：
End Enum


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

Private Type LUID
        lowpart As Long
        highpart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
        pLuid As LUID
        Attributes As Long
End Type

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

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias _
"LookupPrivilegeValueA" (ByVal lpSystemName As String, _
ByVal lpName As String, lpLuid As LUID) As Long

Private 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

Private Declare Function OpenProcessToken Lib "advapi32.dll" _
(ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long


Private Sub AdjustToken()                           '关闭2000/XP前要先得到关机的特权
        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
        'Get the LUID for shutdown privilege.
        LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
        tkp.PrivilegeCount = 1 ' One privilege to set
        tkp.Privileges(0).pLuid = tmpLuid
        tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
        'Enable the shutdown privilege in the access token of this process.
        AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), _
tkpNewButIgnored, lBufferNeeded
End Sub


Private Sub shutdownwin()                   '关机子程序
        If Optxp.Value Then                         '是XP系统
                on Error GoTo errorp
                AdjustToken                               '关闭2000/XP前要先得到关机的特权
                Call ExitWindowsEx(EWX_POWEROFF, 0)       '正常关闭2000/XP
                End                                       '结束本程序
        End If
        If Opt98.Value Then                         '是98系统
                on Error GoTo errorp
                Call ExitWindowsEx(EWX_SHUTDOWN, 0)       '正常关闭
                End                                       '结束本程序
        End If
        errorp: MsgBox "无法执行关机操作，可能本软件不适用于本机操作系统"               '出错提示
End Sub


Private Sub Cmdstart_Click()
        Cmbsh1.Enabled = False                       '一旦开始就都不可设定
        Cmbfen1.Enabled = False
        Txtsh2.Enabled = False
        Cmbfen2.Enabled = False
        Optds.Enabled = False                         '选择按钮组锁定
        Optdjs.Enabled = False
        Cmdstart.Visible = False                     '本按钮隐藏
        cmdstop.Visible = True
        qdtime = Time()                               '计时起点
        Timer2.Enabled = True                         '开始计时
End Sub


Private Sub cmdstop_Click()
        ask = MsgBox("正在计时，确定要停止吗？", vbYesNo + vbDefaultButton1, "ask")
        If ask = vbYes Then
                Cmbsh1.Enabled = True                       '停止后设定框恢复以前状态
                Cmbfen1.Enabled = True
                Txtsh2.Enabled = True
                Cmbfen2.Enabled = True
                Optds.Enabled = True                         '选择按钮组开锁
                Optdjs.Enabled = True
                Cmdstart.Visible = True
                cmdstop.Visible = False                     '本按钮隐藏
                Timer2.Enabled = False                     '停止计时
                Labxge.Caption = "设定好时间后点击 开始计时"
        End If
End Sub


Private Sub Command1_Click()
        form1.Hide
        Form2.Show
End Sub


Private Sub Form_Initialize()
        imglft = Image1.Left                         '退出图标左坐标初值
        If Val(Hour(Time())) = 23 Then               '定时模式小时设定组合框初值为系统小时的下一小时
                chuzhi = "00"
        Else
                chuzhi = Trim(Val(Hour(Time())) + 1)
        End If
        Cmbsh1.Text = Right(("00" + chuzhi), 2)     '定时模式小时设定组合框赋初值
        For i = 0 To 23                                         '定时模式小时设定组合框初始化
                Cmbsh1.AddItem (Right("00" + Trim(Str(i)), 2))
        Next i
        Cmbfen1.Text = Right("00" + Trim(Minute((Time()))), 2) '定时模式分钟设定组合框初值为系统分钟
        For i = 0 To 59                                         '定时模式分钟设定组合框初始化
                Cmbfen1.AddItem (Right("00" + Trim(Str(i)), 2))
        Next i
        Txtsh2 = "01"                                           '倒计时模式小时设定初值为01
        Cmbfen2.Text = "00"                                     '倒计时模式分钟设定组合框初值为00
        For i = 0 To 59                                         '倒计时模式分钟设定组合框初始化
                Cmbfen2.AddItem (Right("00" + Trim(Str(i)), 2))
        Next i
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        Image1.Left = imglft           '图标移回原位
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
        ask = MsgBox("确定要退出程序吗？", vbYesNo + vbDefaultButton1, "ask")
        If ask = vbYes Then
                End                         '直接退出
        Else
                Cancel = True             '取消退出
        End If

End Sub


Private Sub Image1_Click()
        Unload Me
End Sub


Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        Image1.Left = imglft * 1.008             '图标左移
End Sub


Private Sub Label1_Click()
        Shell "Explorer.exe http://yyhacker.com", vbMaximizedFocus '访问作者BLOG以报告错误，交流技术
End Sub


Private Sub Optdjs_Click()                             '倒计时模式则定时设定隐藏
        If Optdjs.Value = True Then
                Cmbsh1.Visible = False
                Cmbfen1.Visible = False
                Lab(0).Visible = False
                Lab(1).Visible = False

                Txtsh2.Visible = True
                Cmbfen2.Visible = True
                Lab(2).Visible = True
                Lab(3).Visible = True

        End If
End Sub


Private Sub Optds_Click()
        If Optds.Value = True Then                             '定时模式则倒计时设定隐藏
                Cmbsh1.Visible = True
                Cmbfen1.Visible = True
                Lab(0).Visible = True
                Lab(1).Visible = True
                Txtsh2.Visible = False
                Cmbfen2.Visible = False
                Lab(2).Visible = False
                Lab(3).Visible = False
        End If
End Sub


Private Sub Timer1_Timer()
        Labtime.Caption = "系统时间：" + Str(Time())
End Sub


Private Function fenxge(shdsh As Variant, shdfen As Variant)         '自定义函数，比较设定时间与当前时间相隔的分钟
        xzsh = Hour(Time)                                     '当前的小时
        xzfen = Minute(Time)                                 '当前的分钟
        If (shdsh * 60 + shdfen) < (xzsh * 60 + xzfen) Then               '设定的时间比当前时间小时，一下一天计算
                shdsh = shdsh + 24
        End If
        fenxge = (shdsh * 60 + shdfen) - (xzsh * 60 + xzfen)
End Function


Private Sub Timer2_Timer()                           '比较设定时间和当前时间，判断剩余时间
        If Optds.Value = True Then                           '定时模式
                shdsh1 = Val(Cmbsh1.Text)                           '设定的小时
                shdfen1 = Val(Cmbfen1.Text)                         '设定的分钟
                xge1 = fenxge(shdsh1, shdfen1)                     '调用子函数求相隔时间
                Labxge.Caption = "离关机还有：" + Trim(Str(xge1 \ 60)) + "小时" + Str(xge1 Mod 60) + "分钟！"

                If xge1 = 0 Then
                        shutdownwin                                                 '调用关机子程序
                        Timer2.Enabled = False
                End If
        End If
        If Optdjs.Value = True Then                                   '倒计时模式
                shdfen2 = (Val(Minute(qdtime)) + Val(Cmbfen2.Text)) Mod 60   '关机时分钟为起点时间的分钟加设定分钟 mod 60
                jinwei = (Val(Minute(qdtime)) + Val(Cmbfen2.Text)) \ 60     '分钟的进位值
                shdsh2 = Val(Hour(qdtime)) + Val(Txtsh2.Text) + jinwei       '关机小时为起点时间的小时加分钟进位值
                xge2 = fenxge(shdsh2, shdfen2)                               '调用子函数求相隔时间
                Labxge.Caption = "离关机还有：" + Trim(Str(xge2 \ 60)) + "小时" + Str(xge2 Mod 60) + "分钟！"

                If xge2 = 0 Then
                        shutdownwin                                                 '调用关机子程序
                        Timer2.Enabled = False
                End If
        End If
End Sub


Private Sub Txtsh2_Change()                           '限制txet只能接受数字输入
        If Not (IsNumeric(Txtsh2.Text)) Then
                Txtsh2.Text = "01"
        End If
End Sub
Private Sub Txtsh2_KeyPress(KeyAscii As Integer)       '限制txet只能接受数字输入
        Dim txt   As String
        If KeyAscii = vbKeyBack Then Exit Sub
        txt = Txtsh2.Text & Chr(KeyAscii)
        If Not (IsNumeric(txt)) Then
                KeyAscii = 0
        End If
End Sub



2.form2（隐藏表单）的源码

'hWnd变元是窗口的句柄；x，y是窗口的左上角的坐标；cx、cy是窗口宽度和高度；
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = - 1             '把窗口放在窗口清单的顶部
Private Const SWP_SHOWWINDOWS = &H40       'SWP_SHOWWINDOW 显示窗口
Private Sub Form_Load()
        Dim retValue As Long
        retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, 200, 0, 380, 25, SWP_SHOWWINDOWS)
End Sub


Private Sub Form_Click() '单击返回主界面
        form1.Show
        Form2.Hide
End Sub


Private Sub Label1_Click()
        form1.Show
        Form2.Hide
End Sub


Private Sub Labtime_Click()
        form1.Show
        Form2.Hide
End Sub


Private Sub Labxge_Click()
        form1.Show
        Form2.Hide
End Sub


Private Sub Timer1_Timer()
        Labtime.Caption = Time()
        If Not form1.Labxge.Visible Then
                Labxge.Caption = "没有设定关机时间"
        Else
                Labxge.Caption = form1.Labxge.Caption       '得到form1的剩余时间信息
        End If
End Sub
<>