frm_定时关机.frm

一个用VB开发的非常不错的企业ERP管理源码,值得一看.

VERSION 5.00
Begin VB.Form Frm_定时关机 
   Caption         =   "定时关机"
   ClientHeight    =   2565
   ClientLeft      =   60
   ClientTop       =   390
   ClientWidth     =   4680
   Icon            =   "Frm_定时关机.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form12"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2565
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command2 
      Caption         =   "取消"
      Height          =   375
      Left            =   2220
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   1980
      Width           =   975
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   3660
      Top             =   1140
   End
   Begin VB.TextBox Text7 
      Alignment       =   2  'Center
      Height          =   315
      Left            =   420
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   60
      Visible         =   0   'False
      Width           =   1575
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   375
      Left            =   3480
      TabIndex        =   4
      Top             =   1980
      Width           =   975
   End
   Begin VB.TextBox Text2 
      Alignment       =   2  'Center
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   1380
      TabIndex        =   1
      Text            =   "12"
      Top             =   1320
      Width           =   495
   End
   Begin VB.TextBox Text1 
      Alignment       =   2  'Center
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   1860
      Locked          =   -1  'True
      TabIndex        =   0
      TabStop         =   0   'False
      Text            =   ":"
      Top             =   1320
      Width           =   270
   End
   Begin VB.TextBox Text3 
      Alignment       =   2  'Center
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   2100
      TabIndex        =   2
      Text            =   "00"
      Top             =   1320
      Width           =   495
   End
   Begin VB.TextBox Text4 
      Alignment       =   2  'Center
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   2580
      Locked          =   -1  'True
      TabIndex        =   8
      TabStop         =   0   'False
      Text            =   ":"
      Top             =   1320
      Width           =   270
   End
   Begin VB.TextBox Text5 
      Alignment       =   2  'Center
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   2820
      TabIndex        =   3
      Text            =   "00"
      Top             =   1320
      Width           =   495
   End
   Begin VB.TextBox Text6 
      Height          =   375
      Left            =   1320
      TabIndex        =   9
      TabStop         =   0   'False
      Top             =   1260
      Width           =   2055
   End
   Begin VB.Label Label2 
      Caption         =   "请输入要关机的时间："
      Height          =   375
      Left            =   1200
      TabIndex        =   7
      Top             =   840
      Width           =   2055
   End
   Begin VB.Label Label1 
      Caption         =   "    此功能不对文件作保存，在使用前请保存一下文件，以免文件丢失。"
      ForeColor       =   &H00000080&
      Height          =   375
      Left            =   1200
      TabIndex        =   6
      Top             =   360
      Width           =   3135
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   600
      Picture         =   "Frm_定时关机.frx":0442
      Top             =   360
      Width           =   480
   End
End
Attribute VB_Name = "Frm_定时关机"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim txtTime     '保存输入时间
Dim nowTime     '保存实时时间
Dim oldTime     '保存开始定时时间

Enum HowExitConst
               EWX_FORCE = 4 ' 强制关机
               EWX_LOGOFF = 0 ' 登出
               EWX_REBOOT = 2 ' 重开机
               EWX_SHUTDOWN = 1 ' 关机
  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 ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
         ByVal dwReserved As Long) As Long
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

Dim Clos
Private 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

'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 Command1_Click()
a1 = True
Clos = 1
If Len(Text2.Text) = 1 Then
Text2.Text = 0 & Text2.Text
End If
If Len(Text3.Text) = 1 Then
Text3.Text = 0 & Text3.Text
End If
If Len(Text5.Text) = 1 Then
Text5.Text = 0 & Text5.Text
End If
Text7.Text = Text2.Text & Text1.Text & Text3.Text & Text4.Text & Text5.Text
主窗体.Text1.Text = Text7.Text
主窗体.Text1.Visible = True
主窗体.Text2.Visible = True
n = Text7.Text
n = WritePrivateProfileString("定时关机", "b" & 1, _
n, App.Path + "\data\ADR.ini")
Call TimeClose
'Unload Me
End Sub

Private Sub Command2_Click()
主窗体.Text1.Visible = False
主窗体.Text2.Visible = False
Unload Me
End Sub
Private Sub Form_Deactivate()
If Clos = 0 Then
Beep
Me.Show
End If
End Sub
Private Sub TimeClose()
 oldTime = Time
    If Not IsDate(Text7.Text) Then '用IsData函数判断输入的时间格式
       MsgBox "你所输入的不是时间格式,请重试!", , "Wrong"
    Else
        txtTime = TimeValue(Text7.Text)
        'txtTime = TimeSerial(Text7.Text)
        Timer1.Enabled = True   '启动定时器
        'Unload Me
        Me.WindowState = 1     '最小化窗体
    End If
'Call ExitWindowsEx(EWX_SHUTDOWN, 0)
End Sub

Private Sub Form_Load()
Clos = 0
n = GetPrivateStringValue("定时关机", "b" & _
1, App.Path + "\data\ADR.ini")
Text2.Text = Mid(n, 1, 2)
Text3.Text = Mid(n, 4, 2)
Text5.Text = Mid(n, 7, 2)
End Sub
Private Sub Clse()
'主窗体.Text2.Text = "定时到"
 AdjustToken
 Call ExitWindowsEx(EWX_SHUTDOWN, 0)
End Sub
Private Sub Timer1_Timer()
       nowTime = Time
          If DateDiff("s", nowTime, txtTime) < 0 Then
        Call Clse
        Timer1.Enabled = False
        Unload Me
         End If
End Sub