frmwarning.frm

优盘 锁定监视器

VERSION 5.00
Begin VB.Form frmWarning 
   Caption         =   "警告.."
   ClientHeight    =   5805
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4605
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   ScaleHeight     =   5805
   ScaleWidth      =   4605
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "请保存所有的工作"
      Height          =   5295
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4575
      Begin VB.Timer tmrCountDown 
         Enabled         =   0   'False
         Interval        =   1000
         Left            =   3720
         Top             =   4680
      End
      Begin VB.Label Label3 
         Caption         =   "秒."
         Height          =   255
         Left            =   2040
         TabIndex        =   4
         Top             =   4320
         Width           =   1695
      End
      Begin VB.Label lblSeconds 
         Caption         =   "60"
         Height          =   255
         Left            =   1560
         TabIndex        =   3
         Top             =   4320
         Width           =   255
      End
      Begin VB.Label Label2 
         Caption         =   "倒计时: "
         Height          =   255
         Left            =   600
         TabIndex        =   2
         Top             =   4320
         Width           =   855
      End
      Begin VB.Label Label1 
         Caption         =   "程序不久将重启或者关闭计算机。"
         Height          =   3375
         Left            =   240
         TabIndex        =   1
         Top             =   240
         Width           =   4095
      End
   End
End
Attribute VB_Name = "frmWarning"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Dim Reg As clsReg

Private countDown As Integer
Private currentlyLocking As Boolean

Public Function checkSecurity()
Dim arrID() As String
Dim tmpArr() As String
Dim KeyCollection As Collection
Dim Object As Variant
Dim i As Integer, usbOn As Integer
Dim doLock As Boolean
On Error GoTo badMonkey
 
 doLock = True
 Set Reg = New clsReg
  arrID = Split(getFolders(glUSBStor), ",")
  For i = 0 To UBound(arrID)
   Set Reg = New clsReg
   Set KeyCollection = Reg.EnumRegistryValues(HKEY_LOCAL_MACHINE, glUSBStor & "\" & arrID(i) & "\Control")
    usbOn = 0
    For Each Object In KeyCollection
     usbOn = Object(1)
    Next
   Set KeyCollection = Nothing
   tmpArr = Split(arrID(i), "#"): usbID = tmpArr(5)
   If GetSetting(App.EXEName, "usbKeys", onlyNumbers(CStr(usbID)), 0) = 1 And usbOn = 1 Then
    If doExit = True Then
     Unload frmMain
     Unload frmOptions
     frmSystray.closeSystray
     Unload Me
     End
     End
    End If
    tmrCountDown.Enabled = False
    appActive = True
    frmSystray.tmrSecurity.Enabled = True
    Unload Me
    Exit Function
   End If
  Next i
 Set Reg = Nothing
 If doLock Then
  If doExit Then
   MsgBox "你必须持有系统密钥方能关闭本程序!", vbCritical, "警告"
   doExit = False
  Else
   Me.Show
   tmrCountDown.Enabled = True
  End If
 End If
Exit Function

badMonkey:
 MsgBox Err.Description, vbCritical, Err.Number
 Resume Next
End Function

Private Function getFolders(strWhere As String) As String
Dim KeyCollection As Collection
Dim Object As Variant
 Set KeyCollection = Reg.EnumRegistryKeys(HKEY_LOCAL_MACHINE, strWhere)
  For Each Object In KeyCollection
   getFolders = getFolders & Trim(Object) & ","
  Next
 Set KeyCollection = Nothing
 If Len(getFolders) > 0 Then getFolders = Mid(getFolders, 1, Len(getFolders) - 1)
End Function

Private Sub Form_Load()
 countDown = 60
End Sub

Private Sub tmrCountDown_Timer()
Dim cWindows As New clsWindows
 DoEvents
 countDown = countDown - 1
 lblSeconds = countDown
 checkSecurity
 If countDown <= 0 Then
  Select Case gldoWhat
   Case 0
    'freeze the computer
    'still in progress
   Case 1: cWindows.ExitWindows WE_LOGOFF
   Case 2: cWindows.ExitWindows WE_SHUTDOWN
   Case Else: MsgBox "无效的情形声明.", vbCritical, "提示"
  End Select
  tmrCountDown.Enabled = False
  Unload Me
 End If
End Sub