frmmain.frm

Usb Key loock vb soucrse code. ocx not found

End Sub

Private Sub Form_Load() '橇肺弊伐捞 矫累登绰 矫痢
 Hook Me '扑诀皋春甫 饶欧窍扁 困窃


Call InterruptDuplicateExecution
'//辑滚 葛碘阑 龋免窍绰 巴捞促.
'//捞 葛碘篮 橇肺弊伐捞 犁角青登绰 何盒阑 阜酒林绰 扁瓷阑 茄促.
'Me.Hide

'//归档绢 惑怕俊辑 累悼窍档废 汽阑 焊捞瘤 臼霸 茄促.

Set m_clsSubcls = New cSubclass
     m_clsSubcls.Subclass Me.hwnd, Me
     m_clsSubcls.AddMsg Me.hwnd, WM_DEVICECHANGE
     '辑宏 努贰胶 积己茄促.

usb_device_name_result = False
usb_device_volume_result = False
usb_device_serial_result = False
'葛电 boolean 蔼阑 false肺 刚历 汲沥茄促.
End Sub



Private Function ChkKey(f As String) As Boolean
On Error GoTo ExitThis
Dim fp As Integer
Dim tmp As String
    fp = FreeFile
    Open f For Input As #fp
        Line Input #fp, tmp
    Close #fp
    'MsgBox tmp
    UnLockKey = GetSetting("USB System Lock", "", "Key", , HKEY_LOCAL_MACHINE)
    If tmp = UnLockKey Then ChkKey = True Else ChkKey = False
    Exit Function
ExitThis:
    ChkKey = False
End Function
'// usb 靛扼捞宏俊 菩胶况靛 皋捞目肺 力累等 鞠龋拳虐甫 usb 靛扼捞宏俊辑 八祸阑茄促.
'//父距俊 usb 靛扼捞宏狼 格废吝俊 八祸搬苞 饭瘤胶飘俊 历厘等 焊救虐客 老摹且锭绰 chkkey 蔼阑 true
'  肺 汲沥窍绊 绝阑 版快绰 chkkey 蔼阑 false肺 逞变促...

Private Sub ChkADvr() '//阿辆 usb 厘摹甫 八祸窍绰 舅绊府硫捞促.
Dim i As Integer
    ADvrNum = -1
    For i = 68 To 90
        If GetDriveType(Chr(i) + ":\") = 2 Then
            ADvrNum = ADvrNum + 1
            ADvr(ADvrNum) = i
        End If
    Next i
End Sub




Private Sub Timer1_Timer() '单葛 滚傈阑 版快 frmdemo 汽阑 酒贰狼 汲沥茄 鸥捞赣蔼阑 捞侩秦辑
'frmdemo 汽阑 剁况霖促.
On Error Resume Next
Dim i As Long
For i = 0 To 60000
    If i = 60 Then
       SetTopMostWnd frmdemo.hwnd, True
       frmdemo.Show
    End If '
Next i
End Sub

Private Sub tmrCheck_Timer() '//角矫埃栏肺 叼官捞胶疙苞 usb靛扼捞宏 格废阑 八祸茄促.
On Error Resume Next

Call ListADvr '//usb靛扼捞宏 格废阑 阂矾柯促.
Call RefreshDriveList '//叼官捞胶 格废阑 阂矾柯促.

'//角矫埃栏肺 叼官捞胶疙阑 茫绰促.
'//角矫埃栏肺 促官捞胶狼 usb 杭俘疙档 窃膊 茫嚼聪促.
'//角矫埃栏肺 USB 靛扼捞宏郴俊 鞠龋拳虐甫 茫嚼聪促.



UnLockKey = GetSetting("USB System Lock", "", "Key", , HKEY_LOCAL_MACHINE)
'//焊救虐蔼阑 饭瘤胶飘俊辑 阂矾柯促.


 If UnLockKey = "" Then '父距俊 饭瘤胶飘俊 焊救虐啊 绝促搁
    frmnokey.Show 'frmnokey 汽阑 剁款促.
    tmrCheck.Enabled = False '鸥捞赣狼 劝悼阑 辆丰茄促.
    Exit Sub
 End If
'//父距俊 饭瘤胶飘俊 鞠龋拳虐啊 积己登绢 乐瘤 臼促搁
'//Frmnokey 汽阑 焊咯林绊 鸥捞赣甫 泪矫 辆丰钦聪促.
'//弊府绊 捞饶俊 乐绰 内靛绰 角青给窍霸 exit sub 矫诺聪促.




Dim result_Device_name As String '叼官捞胶蔼 函荐
Dim result_device_volume As String 'usb靛扼捞 杭俘俊 措茄 函荐
Dim result_device_Serial As String 'usb靛扼捞宏 绊蜡 矫府倔俊 措茄 函荐

result_Device_name = GetSetting("USB System Lock", "", "Device_name", , HKEY_LOCAL_MACHINE)
result_device_volume = GetSetting("USB System Lock", "", "Device_Volume", , HKEY_LOCAL_MACHINE)
result_device_Serial = GetSetting("USB System Lock", "", "Device_Serial_Num", , HKEY_LOCAL_MACHINE)
result_Device_name = result_Device_name
result_device_volume = result_device_volume
result_device_Serial = result_device_Serial
'//阿阿狼 函荐蔼阑 饭瘤胶飘府俊 历厘等 郴侩栏肺 罐绰促.

'//饭瘤胶飘府俊辑 叼官捞胶 疙苞 叼官捞胶 杭俘阑 阂矾柯促.


With lvwDrives
     Dim i As Integer
     For i = 0 To .ListItems.Count - 1
         If .ListItems(i).SubItems(2) = result_Device_name Then
             usb_device_name_result = True
            ' Exit For
             Else
             usb_device_name_result = False
           '  Exit For
         End If
     Next i
End With

'// 叼官捞胶 疙捞 府胶飘轰 冠胶俊 乐绰 蔼捞 悼老 窍促搁
'//usb_device_name_result 蔼阑 true 肺 搬沥茄促.

With lvwDrives
     Dim ivs As Integer
     For ivs = 0 To .ListItems.Count - 1
         If .ListItems(ivs).SubItems(3) = result_device_Serial Then
            usb_device_serial_result = True
           ' Exit For
            Else
            usb_device_serial_result = False
        ' Exit For
         End If
     Next ivs
End With
'//叼官捞胶 绊蜡 矫府倔 锅龋甫 府胶飘轰 冠胶俊 乐绰 蔼捞 悼老 窍促搁
'//usb_device_serial_result 蔼阑 true 肺 搬沥茄促.

With LstDriver
     Dim II As Integer
     For II = 0 To .Nodes.Count
          If .Nodes(II).Text = result_device_volume Then
              usb_device_volume_result = True
             ' Exit For
              Else
              usb_device_volume_result = False
             ' Exit For
          End If
     Next II
End With
            
'// 叼官捞胶 杭俘疙苞 飘府轰 冠胶俊 乐绰 蔼捞 悼老 窍促搁
'//usb_device_volume_result 蔼阑 true 肺 搬沥茄促.


Dim MyFile As String
Dim iv As Integer
    'KeyOK = False
    For iv = 0 To ADvrNum
        MyFile = Chr(ADvr(iv)) + ":\_USBSL\Key.usl"
        If ChkKey(MyFile) Then
            KeyOK = True
            Exit For
        Else
            KeyOK = False
            Exit For
        End If
    Next iv
    
'//父距俊 饭瘤胶飘俊 历厘等 usb厘摹俊 key.usl 颇老捞 粮犁茄促搁, 弊 key.usl俊 历厘等 鞠龋虐啊
'历厘登 捞促搁 keyok 蔼阑 true肺 汲沥, key.sul 颇老俊 历厘等 鞠龋虐啊 绝促搁
'keyok 蔼阑 false 肺 汲沥茄促.

If usb_device_volume_result = True And usb_device_name_result = True And usb_device_serial_result = True And KeyOK = True Then
   Call UnLockAll
   Exit Sub
Else
   Call LockAll
   Exit Sub
End If
'//叼官捞胶疙苞 叼官捞胶杭俘苞 叼官捞胶 绊蜡矫府倔 虐客 叼官捞胶 厘摹俊辑 焊救虐甫 茫疽绊
'//焊救虐啊 饭瘤胶飘俊 历厘等 蔼苞 悼老窍促搁 攫遏矫虐绊 窍唱扼档 撇府促搁 遏欧 矫挪促.
 
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))
    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
End Sub


Private Sub RefreshDriveList() '叼官捞胶 靛扼捞宏狼 函拳俊 蝶弗 府胶飘轰 府敲饭浆 窍扁困窃
On Error Resume Next
    Dim strDriveBuffer  As String '靛官捞胶狼 鸥涝阑 沥狼 窍扁 困秦
    Dim strDrives()     As String '叼官捞胶狼 靛扼捞宏 免仿 窍扁 困秦
    Dim i               As Long
    Dim udtInfo         As DEVICE_INFORMATION '叼官捞胶 沥焊
    
    Dim sDrive() As String
    Dim sVoume As String
    Dim sFileSystem As String
    Dim sSerialNumber As String
    
    Set usb_Serial = New clsDriveSerial
    
    
    strDriveBuffer = Space(240) '傍埃阑 240 沥档肺 且寸茄促.
    strDriveBuffer = Left$(strDriveBuffer, GetLogicalDriveStrings(Len(strDriveBuffer), strDriveBuffer))
    strDrives = Split(strDriveBuffer, Chr$(0))

    lvwDrives.ListItems.Clear '府胶飘轰狼 檬扁拳

    For i = 0 To UBound(strDrives)   '叼官捞胶甫 八祸茄促.
    
        usb_Serial.GetDrives sDrive
        usb_Serial.GetDriveInfo sDrive(i), sVoume, sFileSystem, sSerialNumber
        With lvwDrives.ListItems.Add(Text:=strDrives(i)) '叼官捞胶狼 靛扼捞宏 免仿
            udtInfo = GetDevInfo(strDrives(i))
            
            If udtInfo.Valid Then
                Select Case udtInfo.BusType
                    Case BusTypeUsb:        .SubItems(1) = "USB"
                    Case BusType1394:       .SubItems(1) = "1394"
                    Case BusTypeAta:        .SubItems(1) = "ATA"
                    Case BusTypeAtapi:      .SubItems(1) = "ATAPI"
                    Case BusTypeFibre:      .SubItems(1) = "Fibre"
                    Case BusTypeRAID:       .SubItems(1) = "RAID"
                    Case BusTypeScsi:       .SubItems(1) = "SCSI"
                    Case BusTypeSsa:        .SubItems(1) = "SSA"
                    Case BusTypeUnknown:    .SubItems(1) = "Unknown"
                End Select
                
                .SubItems(2) = Trim$(udtInfo.VendorID & " " & udtInfo.ProductID & " " & udtInfo.ProductRevision)
                .SubItems(3) = sSerialNumber
                '辑宏(2)俊绰 叼官捞胶 疙阑 免仿窍霸 茄促.
               ' .Tag = strDrives(i) '抛弊甫 叼官捞胶 靛扼捞宏 肮荐父怒 霖促.
            End If
        End With
        
    Next
End Sub

Private Sub UnLockAll() '攫遏矫懦锭 荤侩登绰 辑宏葛碘
On Error Resume Next
    BlockInput False
    ShowCursor True
    ' 单胶农啪 酒捞能 汗盔(焊捞霸窃)
    Dim Hwd As Long
    Dim rtn As Long
    Hwd = FindWindow("Progman", vbNullString)
    rtn = ShowWindow(Hwd, SW_RESTORE)
    ' 抛胶农官 汗盔(焊捞霸窃)
    Hwd = FindWindow("Shell_traywnd", vbNullString)
    rtn = ShowWindow(Hwd, SW_RESTORE)
    '累诀包府磊 汗盔(劝己拳窃)
    Call SaveDWSetting("Microsoft", "Windows\CurrentVersion\Policies\System", "DisableTaskMgr", 0, HKEY_CURRENT_USER)
    frmshow.Hide
End Sub

Private Sub LockAll() '遏矫懦锭 荤侩登绰 辑宏葛碘
On Error Resume Next
    BlockInput True
    ShowCursor False
    ' 单胶农砰 酒捞能 力芭(救焊烙)
    Dim Hwd As Long
    Dim rtn As Long
    Hwd = FindWindow("Progman", vbNullString)
    rtn = ShowWindow(Hwd, SW_HIDE)
    
    ' 抛胶农官 力芭(救焊烙)
    Hwd = FindWindow("Shell_traywnd", vbNullString)
    rtn = ShowWindow(Hwd, SW_HIDE)
    
    keybd_event VK_LWIN, 0, 0, 0
    keybd_event Asc("M"), 0, 0, 0
    keybd_event VK_LWIN, 0, KEYEVENTF_KEYUP, 0
    
    Call SaveDWSetting("Microsoft", "Windows\CurrentVersion\Policies\System", "DisableTaskMgr", 1, HKEY_CURRENT_USER)
    Call SetCursorPos(Me.Left + (Me.Width \ 2), Me.Top + (Me.Height \ 2))
    Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3) '汽阑 亲惑困俊
    'SetTopMostWnd frmshow.hwnd, True
    frmshow.Show
End Sub