frm_usb_passwizard.frm

Usb Key loock vb soucrse code. ocx not found

End With
End Sub

Private Sub SSCommand2_Click() '盎脚滚畔
'鸥捞赣甫 泪矫 肛眠绊 扑诀皋春阑 阂矾可聪促.
Timer2.Enabled = False
Me.PopupMenu 八祸厘摹
End Sub

Private Sub SSCommand3_Click() '促澜栏肺 逞绢啊绰 霉锅掳 滚畔
On Error GoTo err_next
Me.Timer2.Enabled = False

 If lvwDrives.SelectedItem.SubItems(1) <> "USB" Then
         MsgBox "叼官捞胶 格废吝 USB 厘摹父 急琶 啊瓷钦聪促.", vbCritical, Me.Caption
         Exit Sub
 End If

'父距俊 靛扼捞宏 格废吝 窍唱档 急琶茄巴捞 绝芭唱 叼官捞胶疙阑 急琶窍瘤 臼疽促搁
  If LstDriver.SelectedItem.Selected = False Or LstDriver.SelectedItem.Text = "靛扼捞宏" And _
     lvwDrives.SelectedItem.Text <> "" Then
    
     MsgBox "巩力 惯积, 秦搬规过 : " & vbCrLf _
          & "" & vbCrLf _
          & "USB 靛扼捞宏 格废吝 茄啊瘤甫           " & vbCrLf _
          & "急琶秦 林绞矫坷.", vbCritical, Me.Caption
    Exit Sub
  Else
     Label4.Caption = lvwDrives.SelectedItem.SubItems(2)
     Label6.Caption = LstDriver.SelectedItem.Text
     SSPanel2.Visible = False
     Me.Height = 4000
     SSPanel1.Top = 0
     SSPanel1.Left = 0
     SSPanel1.Visible = True
  End If
  Exit Sub
  
err_next:
   MsgBox "巩力 惯积, 秦搬规过 : " & vbCrLf _
          & "" & vbCrLf _
          & "USB 靛扼捞宏 格废吝 茄啊瘤甫           " & vbCrLf _
          & "急琶秦 林绞矫坷.", vbCritical, Me.Caption
Exit Sub
  
End Sub

Private Sub SSCommand5_Click()
'捞傈窜拌肺 捞悼窍扼
Me.Height = 5190
SSPanel2.Visible = True
SSPanel1.Visible = False
Timer2.Enabled = True
End Sub

Private Sub SSCommand6_Click()
'促澜窜拌肺 捞悼窍扼
   
    Call GetKey '虐蔼阑 阂矾柯促.
    If Not (CreateDisk) Then 'USB靛扼宏俊 虐蔼阑 历厘给沁促搁...
       MsgBox "巩力 惯积, 秦搬规过 : " & vbCrLf _
          & "" & vbCrLf _
          & "焊救KEY 积己俊 角菩窍看嚼聪促.  " & vbCrLf _
          & "" & vbCrLf _
          & "USB 靛扼捞宏狼 侩樊阑 犬牢窍咯 林绞矫坷. " & vbCrLf _
          & "" & vbCrLf _
          & "趣篮 USB 靛扼捞宏啊 楷搬登瘤 臼疽促搁 厘馒窍咯 林绞矫坷.", vbCritical, Me.Caption
       If CreatedANewKey Then Call DeleteSetting("USB System Lock", "", "Key", HKEY_LOCAL_MACHINE)
       Exit Sub
    Else
'虐蔼阑 阂矾吭绰单 虐蔼阑 阂矾柯促.
'父距俊 USB靛扼捞宏俊 鞠龋拳虐甫 积己窍瘤 给沁促搁
'舅覆汽阑 剁况辑 舅妨霖促.
'父距俊 沥惑利栏肺 货肺款 鞠龋拳虐甫 积己沁促搁
'扁粮俊 历厘等 鞠龋拳虐甫 饭瘤胶飘俊辑 昏力茄促.
       ' If CreatedANewKey Then
       '    Call DeleteSetting("USB System Lock", "", "Key", HKEY_LOCAL_MACHINE)
       ' End If
     
     
    With frm_usb_passwizard
         .SSPanel2.Visible = False
         .SSPanel1.Visible = False
         .SSPanel3.Top = 0
         .SSPanel3.Left = 0
         .SSPanel3.Visible = True
    End With
 End If
End Sub

Private Sub SSCommand8_Click() '辆丰 滚畔
On Error Resume Next
Dim Msg As String
    Msg = MsgBox("鞠龋拳虐 积己阑 辆丰 且鳖夸? " & vbCrLf & _
    "" & vbCrLf & _
    "鞠龋拳 虐甫 积己窍瘤 臼栏搁, 沥惑 累悼 窍瘤 臼嚼聪促.", vbYesNo + vbQuestion, Me.Caption)
    Timer2.Enabled = False
If Msg = vbYes Then
   Timer2.Enabled = False
   End '// yes 滚畔阑 穿福搁 橇肺弊伐阑 辆丰钦聪促.
   Else
   Timer2.Enabled = True
End If
End Sub

Private Sub SSCommand9_Click() '付瘤阜 窜拌 辆丰滚畔
On Error GoTo err_msg
If Me.Option1.Value = True Then 'usb 磊悼角青 扁瓷阑 秦力 沁阑版快
   Call RegiSaveDWord(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDriveTypeAutoRun", 52)
   '//饭瘤胶飘府俊 困狼蔼阑 官操霖促.
   MsgBox "USB 磊悼角青 扁瓷阑 秦力 且版快" & vbCrLf & _
          "" & vbCrLf & _
          "漂沥 哪腔磐俊辑绰 哪腔磐甫 茄锅 府何泼阑 秦具父 " & vbCrLf & _
          "" & vbCrLf & _
          "沥惑 累悼 窍绰 版快啊 乐嚼聪促." & vbCrLf & _
          "" & vbCrLf & _
          "鞠龋拳 虐甫 沥惑利栏肺 积己窍看嚼聪促.", vbInformation, Me.Caption
    Call RegiSaveString(HKEY_LOCAL_MACHINE, "Software\USB System Lock", "Device_name", Me.Label4.Caption)
    Call RegiSaveString(HKEY_LOCAL_MACHINE, "Software\USB System Lock", "Device_Volume", Me.Label6.Caption)
    Call RegiSaveString(HKEY_LOCAL_MACHINE, "Software\USB System Lock", "Device_Serial_Num", Me.lvwDrives.SelectedItem.SubItems(3))
   '//饭瘤胶飘府俊 叼官捞胶蔼阑 涝仿矫挪促.
   
   End '橇肺弊伐 辆丰
   Exit Sub
End If

If Me.Option2.Value = True Then ' usb 磊悼角青 扁瓷阑 秦力 窍瘤 臼疽蝶搁
   Call RegiSaveDWord(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDriveTypeAutoRun", "91")
   '//饭瘤胶飘府俊 困狼蔼阑 官操霖促. 扩档快 扁夯 悸泼蔼捞扁档 窍促.
    Call RegiSaveString(HKEY_LOCAL_MACHINE, "Software\USB System Lock", "Device_name", Me.Label4.Caption)
    Call RegiSaveString(HKEY_LOCAL_MACHINE, "Software\USB System Lock", "Device_Volume", Me.Label6.Caption)
    Call RegiSaveString(HKEY_LOCAL_MACHINE, "Software\USB System Lock", "Device_Serial_Num", Me.lvwDrives.SelectedItem.SubItems(3))
   '//饭瘤胶飘府俊 叼官捞胶蔼阑 涝仿矫挪促.
   MsgBox "鞠龋拳 虐甫 沥惑利栏肺 积己窍看嚼聪促.", vbInformation, Me.Caption
   End '橇肺弊伐 辆丰
   Exit Sub
End If

err_msg:
   MsgBox "坷幅啊 惯积窍看嚼聪促." & vbCrLf & _
          "" & vbCrLf & _
          "俊矾 锅龋 : " & Err.Number & vbCrLf & _
          "" & vbCrLf & _
          "俊矾 盔牢 : " & Err.Description, vbCritical, Me.Caption
   Exit Sub
End Sub

Private Sub Timer2_Timer() 'usb 靛扼捞宏甫 角矫埃栏肺 八祸窍扁困茄 鸥捞赣 捞促.
On Error Resume Next


Call ListADvr
Call RefreshDriveList

 Dim LV As Integer
    For LV = 1 To LstDriver.Nodes.Count
        With LstDriver
             If .Nodes.Count >= 2 Then
                Me.Caption = "鞠龋拳虐 积己 橇肺弊伐 " & "Ver." & App.Major & "." & App.Minor & "." & App.Revision & " - 楷搬凳"
                plugin.Picture = usb_ok.Picture
             Else
                Me.Caption = "鞠龋拳虐 积己 橇肺弊伐 " & "Ver." & App.Major & "." & App.Minor & "." & App.Revision & " - 楷搬救凳"
                plugin.Picture = usb_not.Picture
             End If
        End With
    Next LV




'//滴俺狼 辑宏 橇肺矫廉甫 阂矾辑 累悼矫挪促.
'//滴俺狼 辑宏 橇肺矫廉甫 茫酒辑 家胶 盒籍秦焊扁 官而聪促.

End Sub

Private Function GetVolumeLabel(PathName As String) As String 'usb 靛扼捞宏 饭骇免仿
    
    Dim r As Long
    Dim pos As Integer
    Dim hword As Long
    Dim HiHexStr As String
    Dim lword As Long
    Dim LoHexStr As String
    Dim VolumeSN As Long
    Dim MaxFNLen As Long
    Dim DrvVolumeName As String
    
    Dim UnusedStr As String
    Dim UnusedVal1 As Long
    Dim UnusedVal2 As Long
    
    DrvVolumeName = Space$(14)
    UnusedStr = Space$(32)
    
    r = GetVolumeInformation(PathName, DrvVolumeName, Len(DrvVolumeName), VolumeSN&, UnusedVal1, UnusedVal2, UnusedStr, Len(UnusedStr))
    
    'usb 靛扼捞宏甫 茫瘤 给沁促搁
    plugin.Picture = usb_ok.Picture
    
    If r = 0 Then
       plugin.Picture = usb_not.Picture
       Exit Function
    End If
    
    pos = InStr(DrvVolumeName, Chr$(0))
    If pos Then DrvVolumeName = Left$(DrvVolumeName, pos - 1)
    If Len(Trim$(DrvVolumeName)) = 0 Then DrvVolumeName = "(USB 捞抚捞 绝嚼聪促.)"
    GetVolumeLabel = DrvVolumeName
End Function

Private Sub ListADvr() '府胶飘冠胶俊 八祸茄 USB 靛扼捞宏甫 阂矾柯促.
On Error Resume Next
    Dim i As Long
    Call ChkADvr
    LstDriver.Refresh
  
    With LstDriver
                     .Tag = ""
                     .Nodes.Clear
                     .Nodes.Add , , "USB LOCK", "靛扼捞宏", "drive"
    End With
       
    For i = 0 To ADvrNum
         With LstDriver
                    .Nodes.Add "USB LOCK", tvwChild, "s(" & i & ")", GetVolumeLabel(Chr(ADvr(i)) + ":\ ") + Space(1) + Chr(ADvr(i)) + ":\", "usb"
                    .Nodes.Item(i + 1).Expanded = True
         End With
    Next i
    
    Dim II As Long
    For II = 1 To 100
        With Me.ProgressBar2
             ' Sleep (2)
             .Value = II
             Sleep (1)
             If .Value = 100 Then
                .Value = 0
             End If
        End With
    Next II


   

End Sub

Private Sub ChkADvr() 'usb 靛扼捞宏甫 眉农茄促.
Dim i As Integer
    ADvrNum = -1
    For i = 68 To 90 ' E - Z (A,B = 敲肺乔叼胶农; C = 窍靛叼胶农) D~Z 捞悼侥靛扼捞宏
        If GetDriveType(Chr(i) + ":\") = 2 Then
            ADvrNum = ADvrNum + 1
            ADvr(ADvrNum) = i
        End If
    'Next I
       ' If LstDriver.Nodes.Count > 0 Then
       '     plugin.Picture = usb_not.Picture
       '    Else
       '     plugin.Picture = usb_ok.Picture
       ' End If
        
     
        
    Next i
    
    Dim II As Integer
    'For II = 1 To LstDriver.Nodes.Count
        If LstDriver.Nodes.Count <= 1 Then    '.Count <= 0 Then
            plugin.Picture = usb_not.Picture
           ' Label13.Caption = "∝ 楷搬惑怕 -楷搬 救凳"
        Else
            plugin.Picture = usb_ok.Picture
          '  Label13.Caption = "∝ 楷搬惑怕 -楷搬"
        End If
    'Next II
    
End Sub

Private Function CreateDisk() As Boolean
'鞠龋拳 虐甫 积己茄促.
'急琶茄 USB靛扼捞宏俊 _USBSL 靛扼捞宏客 窃膊 KEY.USL 捞扼绰 鞠龋拳 虐甫 积己茄促
'葛滴 HIDDEN 扁瓷阑 捞侩秦辑 弃靛棺 颇老篮 荤侩磊俊霸 救焊捞霸 茄促.

    On Error GoTo ExitThis
Dim MyFile As String
Dim fp As Integer
    
    Me.ProgressBar1.Value = 10
    Me.Label16.Caption = "鞠龋 叼泛配府 积己吝."
    
    If Dir(Right(LstDriver.SelectedItem.Text, 3) + "_USBSL\", vbDirectory) = "" Then _
        MkDir (Right(LstDriver.SelectedItem.Text, 3) + "_USBSL\")
    SetAttr Right(LstDriver.SelectedItem.Text, 3) + "_USBSL\", vbHidden
    MyFile = Right(LstDriver.SelectedItem.Text, 3) + "_USBSL\Key.usl"
    
    Me.ProgressBar1.Value = 40
    Me.Label16.Caption = "鞠龋 叼泛配府 积己 肯丰."
    fp = FreeFile
    If Dir(MyFile, vbHidden Or vbArchive) <> "" Then SetAttr MyFile, vbNormal
    
    Me.ProgressBar1.Value = 70
    Me.Label16.Caption = "鞠龋 颇老 积己吝."
    Open MyFile For Output As #fp
        Print #fp, UnLockKey
    Close #fp
    SetAttr MyFile, vbHidden Or vbArchive
    CreateDisk = True
    
    Me.ProgressBar1.Value = 100
    Me.Label16.Caption = "鞠龋 颇老 积己 肯丰."
    
    Exit Function
ExitThis:
    CreateDisk = False
    Me.ProgressBar1.Value = 0
    Me.Label16.Caption = "鞠龋虐 积己 角菩"
End Function
Private Sub GetKey() '虐蔼阑 饭瘤胶飘俊 历厘茄促.
        UnLockKey = GetSetting("USB System Lock", "", "Key", , HKEY_LOCAL_MACHINE)
        If UnLockKey = "" Then Call CreateKey '虐蔼阑 饭瘤胶飘俊 八荤沁绰单 蔼捞 绝促搁 虐甫 积己茄促.
End Sub
Private Sub CreateKey() 'usb 靛扼捞宏俊 key蔼阑 历厘茄促.
    CreatedANewKey = True
    UnLockKey = "" '檬扁拳
    Dim md5handler As Object
    Set md5handler = New MD5
    Do
        UnLockKey = UnLockKey + LCase$(md5handler.MD5(Str(Time()) + "USB System Lock" + Str(Rnd * 100))) '虐蔼阑 坊待拳 积己矫挪促.
    Loop Until Len(UnLockKey) >= 128
    Set md5handler = Nothing
    If (Len(UnLockKey) > 128) Then UnLockKey = Left$(UnLockKey, 64) + Right$(UnLockKey, 64)
    Call SaveSetting("USB System Lock", "", "Key", UnLockKey, HKEY_LOCAL_MACHINE)
End Sub