frmmain.frm

Usb Key loock vb soucrse code. ocx not found

VERSION 5.00
Object = "{E7BC34A0-BA86-11CF-84B1-CBC2DA68BF6C}#1.0#0"; "NTSVC.ocx"
Begin VB.Form frmmain 
   Caption         =   "Usb System Agent"
   ClientHeight    =   2895
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3405
   Icon            =   "frmmain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2895
   ScaleWidth      =   3405
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows 扁夯蔼
   Begin VB.Timer tmrCheck 
      Enabled         =   0   'False
      Interval        =   10000
      Left            =   1440
      Top             =   720
   End
   Begin NTService.NTService NTService1 
      Left            =   960
      Top             =   720
      _Version        =   65536
      _ExtentX        =   741
      _ExtentY        =   741
      _StockProps     =   0
      ServiceName     =   "Simple"
      StartMode       =   3
   End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Dim ADvrNum As Integer
Dim ADvr(25) As Integer
Dim mypath As String
Dim USLPath As String
Dim USLRunning As Boolean
Dim UnLockKey As String
Dim FoundKeyFile As String




Private Const HWND_MESSAGE As Long = -3

Private Declare Function SetParent Lib "user32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function RegisterWindowMessage Lib "user32.dll" _
Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long

Private Sub Form_Activate()
Me.Hide
End Sub

Private Sub Form_Load() '橇肺弊伐捞 矫累登绰 矫痢
On Error GoTo err_load
Call InterruptDuplicateExecution
Me.Hide

If Command = "/install" Then
   Call Winservice_maker
   End
   Exit Sub
End If

If Command = "/starts" Then
   Me.NTService1.StartService
   Exit Sub
End If



If Command <> "/install" Or Command <> "/starts" Then
'   frmmsg.Timer1.Enabled = True
'   frmmsg.Show 1
   MsgBox "[颇扼皋磐 蔼捞 绝嚼聪促.]" & vbCrLf & _
          "" & vbCrLf & _
          "[颇扼皋磐]" & vbCrLf & _
          "" & vbCrLf & _
          "-install (扩档快 辑厚胶俊 辑厚胶甫 殿废钦聪促.)" & vbCrLf & _
          "" & vbCrLf & _
          "-start (辑厚胶甫 矫累钦聪促. {辑厚胶甫 殿废饶 累悼钦聪促.})", vbInformation, Me.Caption
   End
   Exit Sub
End If


err_load:
    With frmmain.NTService1
        Call .LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "]" & Err.Description)
    End With
    MsgBox Err.Description, vbCritical, Me.Caption
    End
End Sub



Private Sub Winservice_maker()
 With frmmain.NTService1
                  .DisplayName = "USB SYSTEM LOCK Agent " & App.Major & "." & App.Minor & "." & App.Revision  '辑厚胶 亲格俊 叼胶敲饭捞 捞抚阑 免仿茄促.
                  .Interactive = False      '单胶农砰券版栏肺 款康捞 登霸茄促. False 老版快绰 单胶农砰券版俊辑绰 救焊牢促.
                  .serviceName = "USB SYSTEM LOCK Agent " & App.Major & "." & App.Minor & "." & App.Revision      '辑厚胶 亲格俊 辑厚胶 捞抚阑 免仿茄促.
                  .StartMode = svcStartAutomatic                 '辑厚胶甫 磊悼栏肺 汲沥茄促.
 End With

        Dim reg_dir As String                              '饭瘤胶飘俊 辑厚胶 捞抚阑 茫绰促.
        Dim strhelp As String                             'Description 狼 蔼阑 涝仿窍扁 困茄 蔼捞促.
        reg_dir = "System\CurrentControlSet\Services\" & frmmain.NTService1.serviceName '饭瘤胶飘俊 辑厚胶 捞抚阑 措涝茄促.

        If frmmain.NTService1.Install Then '辑厚胶甫 牢胶喷 窍看促搁
         
           If Right$(App.Path, 1) = "\" Then '叼泛配府 其摹俊 蝶弗 "\" 瘤沥
              mypath = App.Path
            Else
              mypath = App.Path + "\"
        End If
           
           Call RegiSaveString(HKEY_LOCAL_MACHINE, reg_dir, "ImagePath", mypath & App.EXEName & ".exe /starts")
                strhelp = "俺惯荤 : (林) 茄匡家橇飘" & vbCrLf
                strhelp = strhelp & "俺惯磊 :  瘤悼辨" & vbCrLf
                strhelp = strhelp & "楷遏贸 :  010-2641-4990" & vbCrLf
                strhelp = strhelp & "E-mail :  [e-mail]" & vbCrLf
                strhelp = strhelp & "          [e-mail]" & vbCrLf
                strhelp = strhelp & "权其捞瘤: http://www.hanulsoft.x-y.net" & vbCrLf
                strhelp = strhelp & "                                                            "
           Call RegiSaveString(HKEY_LOCAL_MACHINE, reg_dir, "Description", strhelp)
               End
               Exit Sub
               ' MsgBox "辑厚胶 殿废 己傍!!", vbInformation, "茄匡家橇飘 扩档快辑厚胶"
        Else

                MsgBox "俊矾 盔牢 : " & Err.Description & vbCrLf & _
                       "" & vbCrLf & _
                       "俊矾 锅龋 : " & Err.Number, vbCritical, Me.Caption
                End
                Exit Sub
        End If
        
End Sub



Private Sub NTService1_Start(Success As Boolean) '辑厚胶甫 矫累沁促搁
   On Error GoTo Err_Start
   'Call NTService1.LogEvent(svcEventError, svcMessageError, "辑厚胶 沥瘤凳.")
   frmmain.tmrCheck.Enabled = True 'usb厘摹 八祸 鸥捞赣 累悼
   
  
   '橇肺弊伐捞 辆丰登搁 促矫 橇肺弊伐阑 角青矫糯
    
    '肺绊 捞亥飘俊 俊矾蔼阑 涝仿茄促.
    Success = True      '饭器磐俊 扁废己傍窃
Exit Sub

Err_Start:  '俊矾 勤甸傅
    Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & _
         Err.Number & "] " & Err.Description)
    Resume Next ' resume
End Sub

Private Sub NTService1_Stop() '辑厚胶甫 沥瘤沁促搁
   On Error GoTo Err_Stop
   frmmain.tmrCheck.Enabled = False
    If Trim$(Me.Tag) = "" Then UnloadProgram '辑厚胶啊 沥瘤登菌促搁
       End '橇肺弊伐阑 辆丰茄促. 茄锅歹 焊救
Exit Sub

Err_Stop:
    Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & _
         Err.Number & "] " & Err.Description)
End Sub
 


Sub UnloadProgram() '橇肺弊伐阑 辆丰且锭
On Error Resume Next
    Me.Tag = "STOP"
    If NTService1.Running Then NTService1.StopService '酒流档 辑厚胶啊 累悼茄促搁 促矫茄锅歹 辑厚胶甫 辆丰茄促.
    While NTService1.Running
        DoEvents '辑厚胶啊 矫累登绊 乐促搁 瘤加利栏肺 辑厚胶甫 辆丰窍扼绊 瘤矫茄促.
    Wend
 End ' 橇肺弊伐阑 辆丰茄促.
End Sub

Private Sub tmrCheck_Timer()
   'HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\RunOnce
   'HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run
  ' 荤侩磊 付促 肺弊柯 拳搁捞 撇副版快
  ' HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce
  ' HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run
  ' 捞 滴 亲格俊 橇肺弊伐阑 殿废窍搁 啊瓷钦聪促.
  ' 捞吝 RunOnce绰 茄锅 荐青窍搁 绝绢笼聪促.
  
  
  If Right$(App.Path, 1) = "\" Then '叼泛配府 其摹俊 蝶弗 "\" 瘤沥
              mypath = App.Path
  Else
              mypath = App.Path + "\"
  End If
        
        
        
Call RegiSaveString(HKEY_CURRENT_USER, "software\Microsoft\Windows\CurrentVersion\RunOnce", "USB System Lock", mypath & "Usb_system_locker.exe")
Call RegiSaveString(HKEY_CURRENT_USER, "software\Microsoft\Windows\CurrentVersion\Run", "USB System Lock", mypath & "Usb_system_locker.exe")
Call RegiSaveString(HKEY_LOCAL_MACHINE, "software\Microsoft\Windows\CurrentVersion\RunOnce", "USB System Lock", mypath & "Usb_system_locker.exe")
Call RegiSaveString(HKEY_LOCAL_MACHINE, "software\Microsoft\Windows\CurrentVersion\Run", "USB System Lock", mypath & "Usb_system_locker.exe")


'==============================================================================================
 Dim run_program As String '角青登绰 橇肺弊伐疙
   Dim enabled_run_program As String '叼泛配府 汲沥 + 角青登绰 橇肺弊伐疙
   run_program = "USB_System_Locker.exe" '角青登绰 橇肺弊伐疙 措涝
   
   If Right$(App.Path, 1) = "\" Then '风飘扼搁
      enabled_run_program = App.Path & run_program
   Else '风飘啊 酒聪促搁..
      enabled_run_program = App.Path & "\" & run_program
   End If
   
   RunShell enabled_run_program '橇肺弊伐捞 辆丰登菌绰瘤 犬牢窍绰 辑宏葛碘
'   厚劝己拳等 内靛绰 usb system locker 皋牢 橇肺弊伐捞 辆丰登搁 磊悼栏肺 角青登霸窍绰
'    葛碘涝聪促.
'   弊矾唱 累悼矫 鸥捞赣狼 荤侩栏肺 矫乔蜡 痢蜡伏捞 棵扼啊绰 巩力啊 惯积钦聪促.
'   备概窍脚盒捞 捞甫 荐沥窍搁 瞪淀钦聪促.
   
'=============================================================================================

End Sub