frmshow.frm

Usb Key loock vb soucrse code. ocx not found

VERSION 5.00
Begin VB.Form frmshow 
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   1  '窜老 绊沥
   ClientHeight    =   5055
   ClientLeft      =   15
   ClientTop       =   15
   ClientWidth     =   5670
   ControlBox      =   0   'False
   Icon            =   "frmshow.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "frmshow.frx":0442
   ScaleHeight     =   5055
   ScaleWidth      =   5670
   StartUpPosition =   3  'Windows 扁夯蔼
End
Attribute VB_Name = "frmshow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function BlockInput Lib "user32" (ByVal fBlockIt As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_RESTORE = 9
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_LWIN = &H5B
Dim ADvrNum As Integer
Dim ADvr(25) As Integer
Dim MyPath As String
Dim TmrStatus As Boolean
Dim KeyOK As Boolean
Dim UnLockKey As String
Dim HackAlert As Boolean

Private Sub Form_Activate()
 ''   Do
   '     Me.Show '汽阑 焊烙
    '    DoEvents
        'Call LockAll 'windows 矫累滚畔(虐焊靛)+CTRK+ALT+DEL虐 阜澜+累诀包府磊 角青给窍霸阜澜
     '   DoEvents
     '   Call ChkADvr 'USB靛扼捞宏八祸
     '   Call CheckKey 'USB靛扼捞宏俊 粮犁窍绰 KEY蔼 八祸
     '   DoEvents
   ' Loop
End Sub

Private Sub Form_Load()
'汽阑 吝居俊 坷霸窃
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2


Dim t As Single
t = Timer

'汽俊 棵妨柳 侨媚甫 汽狼 祸惑俊 嘎眠绢 SHAP 扁瓷栏肺 捧疙拳 矫糯
If Me.Picture <> 0 Then '侨媚啊 粮犁茄促搁
  Call SetAutoRgn(Me) 'SHAP扁瓷 备泅
End If

    If Right$(App.Path, 1) = "\" Then
        MyPath = App.Path
    Else
        MyPath = App.Path + "\"
    End If
    If LCase$(Right$(App.EXEName, 4)) = ".exe" Then
        MyPath = MyPath + App.EXEName + ".exe"
    Else
        MyPath = MyPath + App.EXEName + ".exe"
    End If
    
    Dim result As String
    result = GetSetting("USB System Lock", "", "Path", , HKEY_LOCAL_MACHINE)
    
    If result = "" Or result <> MyPath Then _
        Call SaveSetting("USB System Lock", "", "Path", MyPath, HKEY_LOCAL_MACHINE)
        
   ' result = GetSetting("Microsoft", "Windows\CurrentVersion\Run", "USB System Lock AutoRun", , HKEY_LOCAL_MACHINE)
   ' If result = "" Or result <> AgentPath Then _
   '     Call SaveSetting("Microsoft", "Windows\CurrentVersion\Run", "USB System Lock AutoRun", AgentPath, HKEY_LOCAL_MACHINE)
    UnLockKey = GetSetting("USB System Lock", "", "Key", , HKEY_LOCAL_MACHINE)
    If UnLockKey = "" Then Call NoKey
    BlockInput True
    ShowCursor False
    Me.Show
    
    ' 单胶农砰 酒捞能 力芭(救焊烙)
    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
    '累诀包府磊 力芭(角青给窍霸窃)
    Dim Tmr As Long
    result = GetSetting("USB System Lock", "", "Locking", "No", HKEY_LOCAL_MACHINE)
    If result = "Yes" Then
        HackAlert = True
        Tmr = GetDWSetting("USB System Lock", "", "DisableTaskMgr", , HKEY_LOCAL_MACHINE)
    Else
        HackAlert = False
        Tmr = GetDWSetting("Microsoft", "Windows\CurrentVersion\Policies\System", "DisableTaskMgr", , HKEY_CURRENT_USER)
    End If
    Call SaveDWSetting("USB System Lock", "", "DisableTaskMgr", Tmr, HKEY_CURRENT_USER)
    Call SaveDWSetting("Microsoft", "Windows\CurrentVersion\Policies\System", "DisableTaskMgr", 1, HKEY_CURRENT_USER)
    If Tmr = 0 Then TmrStatus = True Else TmrStatus = False
    Call SaveSetting("USB System Lock", "", "Locking", "Yes", HKEY_LOCAL_MACHINE)
    ' 目胶甫 季磐俊 坷霸窃
    Call SetCursorPos(Me.Left + (Me.Width \ 2), Me.Top + (Me.Height \ 2))

End Sub

Private Sub Form_LostFocus()
    Me.SetFocus
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
  ReleaseCapture
  SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub

Private Sub Form_Terminate()
    If Not (KeyOK) Then Shell MyPath, vbNormalFocus
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Not (KeyOK) Then Shell MyPath, vbNormalFocus
End Sub

Private Sub LockAll()
    BlockInput True
    ShowCursor False
    Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3) '汽阑 亲惑困俊 乐霸窃
    
End Sub

Private Sub UnLockAll()
    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)
    '累诀包府磊 汗盔(劝己拳窃)
    If TmrStatus Then Call SaveDWSetting("Microsoft", "Windows\CurrentVersion\Policies\System", "DisableTaskMgr", 0, HKEY_CURRENT_USER)
    Me.Hide
End Sub

Private Sub CheckKey()
Dim MyFile As String
Dim i As Integer
    KeyOK = False
    For i = 0 To ADvrNum
        MyFile = Chr(ADvr(i)) + ":\_USBSL\Key.usl"
        If ChkKey(MyFile) Then
            KeyOK = True
            Exit For
        End If
    Next i
    If KeyOK Then
        Call UnLockAll
        Call CheckHackAlert
        Unload Me
    End If
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
    If tmp = UnLockKey Then ChkKey = True Else ChkKey = False
    Exit Function
ExitThis:
    ChkKey = False
End Function

Private Sub ChkADvr()
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 NoKey()
    MsgBox "WARNING: UNLOCK KEY NOT FOUND!" + vbCrLf + "Please run the [Key Disk Creator] to create a key, " + vbCrLf + _
    "and run this program again." + vbCrLf + vbCrLf + "USB System Lock will now EXIT.", vbCritical Or vbOKOnly, "WARNING!!!"
    KeyOK = True
    End
End Sub

Private Sub CheckHackAlert()
  
End Sub