【VBS】指定任意USB设备作为机器锁

xiaomingtt

整理网盘，翻出自己大约10年前写的脚本，整理一些比较有意思的，看大家有没有需要。

[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 

xiaomingtt

ZhangGFxb 发表于 2018-7-22 11:41
老哥，你10年前就这么牛，现在是不是都超神了

我不是码农，编程只是我的爱好。所以，10年了，一点也没进步，你说气人不。关键，你现在让我写出这些功能，我是做不到了。

ZhangGFxb

xiaomingtt 发表于 2018-7-23 09:18
我不是码农，编程只是我的爱好。所以，10年了，一点也没进步，你说气人不。关键，你现在让我写出这些功能 ...

嗷嗷，嘿嘿嘿，我是学计算机的，现在在学PHP。

MYLQG2ZHX

谢谢分享，没评分了明天来补

Nicholas_tzw

如果我用PE把它干掉是不是没用啦。

ikeeki

感谢分享。

ywfengjie

好东西，感谢分享。

余生一个顾冷轩

感谢分享

wow999

Nicholas_tzw 发表于 2018-7-9 13:54
如果我用PE把它干掉是不是没用啦。

你知道得太多了

peterq521

很有创意的想法 要是出个成品就更好了

我才不是狮子喵

感谢分享，楼主辛苦了

A羽飞

厉害了，大神。