[Visual Basic] 纯文本查看 复制代码
code = "On Error Resume Next" & VbCrLf & "strComputer = " & Chr(34) & "." & Chr(34) & VbCrLf & "Set objWMIService = GetObject(" & Chr(34) & "Winmgmts://" & Chr(34) & "& strComputer & " & Chr(34) & "/Root/Cimv2" & Chr(34) & Chr(41)
code = code & VbCrLf & "set objEventObject = objWMIService.InstancesOf(" & chr(34) & "Win32_USBcontrollerdevice" & chr(34) & chr(41)
code = code & vbcrlf & "for each o in objEventObject" & vbcrlf & "sn = split(replace(o.dependent,chr(34)," & chr(34) & chr(34) & "),chr(61))(1)" & vbcrlf & "if lcase(left(sn,5)) = " & chr(34) & "usb\\" & chr(34) & " then" & vbcrlf
code = code & "for each ud in objWMIService.execquery(" & chr(34) & "select * from Win32_PnPEntity where DeviceID = '" & chr(34) & " & sn & " & chr(34) & chr(39) & chr(34) & chr(41) & vbcrlf
cod = "if ud.description <> " & chr(34) & "USB Root Hub" & chr(34) & " then ss = ss & ud.description & chr(44) & sn & vbcrlf" & vbcrlf
cde = "next" & vbcrlf & "end if " & vbcrlf & "next" & vbcrlf
Execute(code & cod & cde)
If ss = "" Then
MsgBox "没有接入系统的USB设备!" & VbCrLf & "单击 " & Chr(34) & "确定" & chr(34) & " 退出!",16 + 4096,"机器锁"
Wscript.Quit
End If
ar = Split(ss,VbCrLf)
For i = 0 To UBound(ar) - 1
msg = msg & i + 1 & "、" & Left(ar(i),InStr(ar(i),",") - 1) & VbCrLf
Next
Do:Do
a = InputBox("输入 1 ~ " & UBound(ar) & " 选择设为机器锁的设备" & VbcrLf & vbCrLf & msg,"机器锁",1)
If a = False then Wscript.Quit
Loop Until IsNumeric(a)
Loop Until Int(a) > 0 And Int(a) < CInt(UBound(ar) + 1)
a = Int(a) - 1
msg = "(选择1或2,重新接入USB设备系统不能自动恢复;选择3,当USB设备重新接入系统后系统将自动恢复)" & vbCrLf
msg = msg & VbCrLf & "1、注销" & VbCrLf & "2、关机" & VbCrLf & "3、关闭桌面(禁止运行新程序)" & VbCrLf
Do
b = InputBox("请输入数字选择移除设备后的操作:" & VbCrLf & msg,"机器锁","3")
If b = False Then Wscript.Quit
Loop Until b = "1" OR b = "2" Or b ="3"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("Wscript.Shell")
Select Case b
Case "1"
rcd = "CreateObject(" & Chr(34) & "Wscript.Shell" & Chr(34) & ").Run(" & Chr(34) & "cmd /c shutdown -l -f -t 0" & Chr(34) & "),0"
Case "2"
rcd = "CreateObject(" & Chr(34) & "Wscript.Shell" & Chr(34) & ").Run(" & Chr(34) & "cmd /c shutdown -s -f -t 0" & Chr(34) & "),0"
Case "3"
Set feifile = fso.CreateTextFile("unrunprs.vbs")
feifile.writeLine "Set sev = getobject(" & chr(34) & "winmgmts://./root/cimv2" & Chr(34) & Chr(41)
feifile.WriteLine "set obj = sev.ExecNotificationQuery(" & Chr(34) & "SELECT * FROM __InstanceOperationEvent WITHin 1 WHERE TargetInstance ISA 'Win32_Process'" & Chr(34) & Chr(41)
feifile.WriteLine "do" & VbCrLf & "set p = obj.NextEvent()" & VbCrLf & "if p.Path_.Class = " & Chr(34) & "__InstanceCreationEvent" & Chr(34) & " then p.TargetInstance.terminate" & VbCrLf & "loop"
feifile.Close
With fso.CreateTextFile("minwin.vbs")
.Write "set ws = createobject(" & Chr(34) & "shell.application" & Chr(34) & "):do:ws.minimizeall:wsh.sleep 500:loop"
.Close
End With
cde = cde & "Set ws = CreateObject(" & Chr(34) & "WScript.Shell" & Chr(34) & Chr(41) & VbCrLf & "Set shel = GetObject(" & Chr(34) & "winmgmts:\\.\root\cimv2:Win32_Process" & Chr(34) & Chr(41) & VbCrLf
cde = cde & "pt = Chr(34) & " & Chr(34) & WScript.FullName & Chr(34) & " & Chr(34) & " & Chr(34) & Chr(32) & Chr(34) & " & Chr(34) & " & Chr(34) & ws.Currentdirectory & "\unrunprs.vbs" & Chr(34) & " & Chr(34)" & VbCrLf
cde = cde & "pt1 = Chr(34) & " & Chr(34) & WScript.FullName & Chr(34) & " & Chr(34) & " & Chr(34) & Chr(32) & Chr(34) & " & Chr(34) & " & Chr(34) & ws.Currentdirectory & "\minwin.vbs" & Chr(34) & " & Chr(34)" & VbCrLf
rcd = "'ws.Run(" & Chr(34) & "cmd /c taskkill /im explorer.exe /f" & Chr(34) & "),0" & VbCrLf
rcd = rcd & "shel.Create pt,null,null,pid" & VbCrLf
rcd = rcd & "shel.Create pt1,null,null,pid1"
icd = "If pid <> -1 then ws.run(" & Chr(34) & "taskkill /pid " & Chr(34) & "& pid &" & chr(34) & " /f" & chr(34) & "),0" & VbCrLf
icd = icd & "If pid1 <> -1 then ws.run(" & Chr(34) & "taskkill /pid " & Chr(34) & "& pid1 &" & chr(34) & " /f" & chr(34) & "),0" & VbCrLf & "pid = -1:pid1 = -1"
End Select
Set jingfile = fso.CreateTextFile("usblocker.vbs")
jingfile.write "ok = false:pid = -1:pid1 = -1" & vbcrlf & code
jingfile.writeLine "if ud.description = " & chr(34) & left(ar(a),instr(ar(a),",") - 1) & chr(34) & " and sn = " & chr(34) & right(ar(a),len(ar(a)) - instr(ar(a),",")) & chr(34) & " Then ok = True"
jingfile.writeline cde & "if ok = false then" & VbCrLf & rcd & VbCrLf & "End If"
jingfile.Write "strQuery = " & Chr(34) & "SELECT * FROM __InstanceOperationEvent WITHin 2 WHERE TargetInstance ISA 'Win32_PnPEntity' AND TargetInstance.Description = '"
jingfile.WriteLine Left(ar(a),InStr(ar(a),",") - 1) & "' AND TargetInstance.DeviceID = '" & Right(ar(a),Len(ar(a)) - InStr(ar(a),",")) & "'" & chr(34)
jingfile.WriteLine "Set objEventSource = objWMIService.ExecNotificationQuery(strQuery)" & vbcrLf & "Do" & vbcrLf & "Set objEventObject = objEventSource.NextEvent()"
jingfile.WriteLine "Select Case objEventObject.Path_.Class" & VbCrLf & "Case " & Chr(34) & "__InstanceCreationEvent" & Chr(34)
jingfile.Write icd & VbCrLf & "Case " & Chr(34) & "__InstanceDeletionEvent" & Chr(34) & VbCrLf & rcd & VbCrLf & "End Select" & VbCrLf & "Loop"
jingfile.Close
ws.Run "Wscript.exe usblocker.vbs"
msgbox "USB机器锁已启动!" & VbCrLf & "程序将添加自启动,如果安全软件拦截请放行,以使程序可以随系统一起启动",64,"机器锁"
HKEY_LOCAL_MACHINE = &H80000002
Set obre = getobject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
keypt = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
obre.setStringValue HKEY_LOCAL_MACHINE,keypt,"usblocker",Chr(34) & ws.Currentdirectory & "\usblocker.vbs" & Chr(34)
pathname = ws.SpecialFolders("StartMenu") & "\Programs\Accessories\"
set Link = ws.CreateShortcut(pathname & "usblocker.lnk")
Link.TargetPath = "%windir%\system32\wscript.exe"
Link.Arguments = ws.CurrentDirectory & "\usblocker.vbs"
Link.Hotkey = "Ctrl+Shift+L"
Link.Save
set Link = ws.CreateShortcut(pathname & "unlocker.lnk")
Link.TargetPath = "%windir%\system32\taskkill.exe"
Link.Arguments = "/im wscript.exe /f"
Link.Hotkey = "Ctrl+Shift+U"
Link.Save
msg = "您使用电脑时请确保该USB设备以正确接入 !指定! USB端口." & VbCrLf & "您可通过快捷键Ctrl+Shift+U来结束程序." & VbCrLf & "也可以通过Ctrl+Shift+L来启动程序."
If ERR = 0 Then MsgBox "您已经设置 " & Chr(34) & left(ar(a),instr(ar(a),",") - 1) & Chr(34) & " 设备作为机器锁." & VbCrLf & msg,64,"机器锁" Else MsgBox "ERROR : " & ERR,16,"机器锁"
fso.GetFile("usblocker.vbs").Attributes = 3
If b = 3 Then
fso.GetFile("unrunprs.vbs").Attributes = 3
fso.GetFile("minwin.vbs").Attributes = 3
End If
fso.GetFile(pathname & "usblocker.lnk").Attributes = 3
fso.GetFile(pathname & "unlocker.lnk").Attributes = 3
Set ws = Nothing
Set fso = Nothing
Set objWMIService = Nothing
Set obre = Nothing 
[复制链接]
发表于 2018-7-9 13:47
|
发表于 2018-7-23 09:18
