frmoptions.frm

优盘 锁定监视器

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 btnExit_Click()
 Unload Me
End Sub

Private Sub btnClose_Click()
 updateGLsettings
 Unload Me
End Sub

Private Sub btnRefresh_Click()
 getInfo
End Sub

Private Sub btnUpdate_Click()
Dim lstItem As ListItem
Dim tmpIndex As Integer
On Error GoTo badMonkey
 If listv.ListItems.Count = 0 Then GoTo noBananas
 tmpIndex = 0
 For Each lstItem In listv.ListItems
  If lstItem.Checked Then
   SaveSetting App.EXEName, "usbKeys", onlyNumbers(lstItem.Text), "1"
   tmpIndex = tmpIndex + 1
  Else
   SaveSetting App.EXEName, "usbKeys", onlyNumbers(lstItem.Text), "0"
  End If
 Next
 SaveSetting App.EXEName, "usbKeys", "numOfKeys", tmpIndex
Exit Sub

noBananas:
 MsgBox "当前无内容更新...", vbInformation, "提示"
Exit Sub

badMonkey:
 MsgBox Err.Description, vbCritical, Err.Number
 Resume Next
Exit Sub

End Sub

Private Sub chkAutoStart_Click()
 SaveSetting App.EXEName, "Settings", "autoBoot", chkAutoStart.Value
 Select Case chkAutoStart
  Case 0: DoNotStartUp App.Path & "\" & App.EXEName & ".exe", App.EXEName
  Case 1: DoStartUp App.Path & "\" & App.EXEName & ".exe", App.EXEName
 End Select
End Sub

Private Sub cmbHours_Click()
 SaveSetting App.EXEName, "Time", "Hours", cmbHours.Text
End Sub

Private Sub cmbMinutes_Click()
 SaveSetting App.EXEName, "Time", "Minutes", cmbMinutes.Text
End Sub

Private Sub cmbSeconds_Click()
 SaveSetting App.EXEName, "Time", "Seconds", cmbSeconds.Text
End Sub

Private Sub Form_Activate()
 Call SetListViewLedger(listv, vbWhite, &HF5F5F5, sizeIcon)
End Sub

Private Sub Form_Load()
Dim i As Integer
 Set m_cHdrIcons = New cLVHeaderSortIcons
 Set m_cHdrIcons.ListView = listv
 Visible = True
 Refresh
 Show
 With listv
  .ListItems.Clear
  .View = lvwReport
  .Sorted = False
 End With
 chkAutoStart.Value = GetSetting(App.EXEName, "Settings", "autoBoot", 0)
 For i = 0 To 59
  cmbHours.AddItem IIf(Len(CStr(i)) = 1, "0" & i, i)
  cmbMinutes.AddItem IIf(Len(CStr(i)) = 1, "0" & i, i)
  cmbSeconds.AddItem IIf(Len(CStr(i)) = 1, "0" & i, i)
 Next i
 cmbHours.Text = GetSetting(App.EXEName, "Time", "Hours", "00")
 cmbMinutes.Text = GetSetting(App.EXEName, "Time", "Minutes", "00")
 cmbSeconds.Text = GetSetting(App.EXEName, "Time", "Seconds", "00")
 optDoWhat(GetSetting(App.EXEName, "doWhat", "doWhat", 2)).Value = True
 getInfo
End Sub

Public Sub getInfo()
Dim tmpArr
Dim arrID() As String
Dim KeyCollection As Collection
Dim Object As Variant
Dim i As Integer
Dim tmpString
On Error GoTo badMonkey
 With listv
  .ListItems.Clear
  .View = lvwReport
  .Sorted = False
  .Checkboxes = True
  .FullRowSelect = True
  Set Reg = New clsReg
  arrID = Split(getFolders(glUSBStor), ",")
  loadLV listv, arrID
  .Refresh
  .Visible = True
 End With
 Exit Sub
badMonkey:
 MsgBox Err.Description, vbCritical, Err.Number
 Resume Next
End Sub

Public Function loadLV(lv As ListView, arr() As String, Optional fieldNumber As Integer, Optional FieldValue As String)
Dim i As Integer
Dim KeyCollection As Collection
Dim Object As Variant
Dim tmpArr() As String, arrUSBINFO() As String
Dim usbID As String, usbMan As String, usbProd As String, usbType As String, usbVendor As String, usbTEMP As String
Dim usbOn As Integer
Dim tmpBoolean As Boolean
 With lv
  .ListItems.Clear
  .ColumnHeaders.Clear
  .ColumnHeaders.Add , , "ID" ', Alignment:=lvwColumnRight
  .ColumnHeaders(1).Tag = "numeric"
  .ColumnHeaders.Add , , "制造商"
  .ColumnHeaders(2).Tag = "string"
  .ColumnHeaders.Add , , "产品"
  .ColumnHeaders(3).Tag = "string"
  .ColumnHeaders.Add , , "激活"
  .ColumnHeaders(4).Tag = "string"
  .View = lvwReport
  .Sorted = False
 End With
 Me.MousePointer = 11
 For i = 0 To UBound(arr)
  DoEvents
   Set Reg = New clsReg
   Set KeyCollection = Reg.EnumRegistryValues(HKEY_LOCAL_MACHINE, glUSBStor & "\" & arr(i) & "\Control")
    usbOn = 0
    For Each Object In KeyCollection
     usbOn = Object(1)
    Next
   Set KeyCollection = Nothing
   tmpArr = Split(arr(i), "#")
    usbType = tmpArr(3)
    usbMan = tmpArr(4)
    usbID = tmpArr(5)
   On Error GoTo badMonkey
   If LCase(Trim(usbType)) = "usbstor" Then
    arrUSBINFO = Split(usbMan, "&")
     usbVendor = Mid(arrUSBINFO(1), 5, Len(arrUSBINFO(1)) - 4)
     usbProd = Mid(arrUSBINFO(2), 6, Len(arrUSBINFO(2)) - 5)
    tmpBoolean = isChecked(usbID)
    lv.ListItems.Add , , usbID, , 0
    lv.ListItems(lv.ListItems.Count).Checked = tmpBoolean
    lv.ListItems(lv.ListItems.Count).ListSubItems.Add , , usbVendor & ""
    lv.ListItems(lv.ListItems.Count).ListSubItems.Add , , usbProd & ""
    If usbOn = 1 Then
     lv.ListItems(lv.ListItems.Count).ListSubItems.Add , , "已激活" & ""
    Else
     lv.ListItems(lv.ListItems.Count).ListSubItems.Add , , "未激活" & ""
    End If
   End If
  Set Reg = Nothing
  SaveSetting App.EXEName, "usbKeys", onlyNumbers(usbID), IIf(tmpBoolean, "1", "0")
 Next i
 Call lvAutosizeControl(lv)
 Me.MousePointer = 0
 Exit Function
badMonkey:
 MsgBox Err.Description, vbCritical, Err.Number
 Resume Next
End Function

Private Function isChecked(theVar As String) As Boolean
Dim x
 isChecked = False
 If Trim(theVar) = "" Then Exit Function
 x = GetSetting(App.EXEName, "usbKeys", onlyNumbers(theVar), "0")
 If x <> "0" Then isChecked = True
End Function

Private Function isUSBon(theVar) As String
 isUSBon = "False"
 If Trim(theVar) = "" Then theVar = 0
 Select Case CInt(theVar)
  Case 0: isUSBon = "False"
  Case 2: isUSBon = "True"
 End Select
End Function

Public Sub lvAutosizeControl(lv As ListView)
Dim col2adjust As Long
 For col2adjust = 0 To lv.ColumnHeaders.Count - 1
  Call SendMessage(lv.hwnd, LVM_SETCOLUMNWIDTH, col2adjust, ByVal LVSCW_AUTOSIZE_USEHEADER)
 Next col2adjust
End Sub

Public Sub SetListViewLedger(lv As ListView, Bar1Color As LedgerColours, Bar2Color As LedgerColours, nSizingType As ImageSizingTypes)
Dim iBarHeight  As Long
Dim lBarWidth   As Long
Dim diff        As Long
Dim twipsy      As Long
 iBarHeight = 0
 lBarWidth = 0
 diff = 0
 On Local Error GoTo SetListViewColor_Error
 twipsy = Screen.TwipsPerPixelY
 If lv.View = lvwReport Then
  With lv
   .Picture = Nothing
   .Refresh
   .Visible = 1
   .PictureAlignment = lvwTile
   lBarWidth = .Width
  End With  ' lv
  With Picture1
   .AutoRedraw = False
   .Picture = Nothing
   .BackColor = vbWhite
   .Height = 1
   .AutoRedraw = True
   .BorderStyle = vbBSNone
   .ScaleMode = vbTwips
   .Top = frmMain.Top - 10000
   .Width = Screen.Width
   .Visible = False
   .Font = lv.Font
   With .Font
    .Bold = lv.Font.Bold
    .Charset = lv.Font.Charset
    .Italic = lv.Font.Italic
    .name = lv.Font.name
    .Strikethrough = lv.Font.Strikethrough
    .Underline = lv.Font.Underline
    .Weight = lv.Font.Weight
    .SIZE = lv.Font.SIZE
   End With  'Picture1.Font
   iBarHeight = .TextHeight("W")
   Select Case nSizingType
    Case sizeNone:
     iBarHeight = iBarHeight + twipsy
    Case sizeCheckBox:
     If (iBarHeight \ twipsy) > 18 Then
      iBarHeight = iBarHeight + twipsy
     Else
      diff = 18 - (iBarHeight \ twipsy)
      iBarHeight = iBarHeight + (diff * twipsy) + (twipsy * 1)
     End If
    Case sizeIcon:
     diff = imgAll.ImageHeight - (iBarHeight \ twipsy)
     iBarHeight = iBarHeight + (diff * twipsy) + (twipsy * 1)
   End Select
   .Height = iBarHeight * 2
   .Width = lBarWidth * 2
   Picture1.Line (0, 0)-(lBarWidth * 2, iBarHeight), Bar1Color, BF
   Picture1.Line (0, iBarHeight)-(lBarWidth * 2, iBarHeight * 2), Bar2Color, BF
   .AutoSize = True
   .Refresh
  End With
  lv.Refresh
  lv.Picture = Picture1.Image
 Else
  lv.Picture = Nothing
 End If  'lv.View = lvwReport
SetListViewColor_Exit:
 On Local Error GoTo 0
 Exit Sub
SetListViewColor_Error:
 With lv
  .Picture = Nothing
  .Refresh
 End With
 Resume SetListViewColor_Exit
End Sub

Private Sub listv_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Dim i As Integer
 If (listv.SortKey = ColumnHeader.Index - 1) Then
  ColumnHeader.Tag = Not Val(ColumnHeader.Tag)
 End If
 listv.SortOrder = Abs(Val(ColumnHeader.Tag))
 listv.SortKey = ColumnHeader.Index - 1
 listv.Sorted = True
 Call m_cHdrIcons.SetHeaderIcons(listv.SortKey, listv.SortOrder)
End Sub

Private Sub tmrGetInfo_Timer()
 DoEvents
 getInfo
 DoEvents
End Sub

Private Sub optDoWhat_Click(Index As Integer)
 SaveSetting App.EXEName, "doWhat", "doWhat", Index
End Sub