'----------------------------------分割线下面的内容复制到记事本-------------------------------------------------
msgbox "如果加密狗存在，请拨掉!",,"注意"
strComputer = "."
strb=""
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colDevices = objWMIService.ExecQuery _
("Select * From Win32_USBControllerDevice")
For Each objDevice in colDevices
strDeviceName = objDevice.Dependent
strQuotes = Chr(34)
strDeviceName = Replace(strDeviceName, strQuotes, "")
arrDeviceNames = Split(strDeviceName, "=")
strDeviceName = arrDeviceNames(1)
Set colUSBDevices = objWMIService.ExecQuery _
("Select * From Win32_PnPEntity Where DeviceID = '" & strDeviceName & "'")
aa=InStr(strDeviceName,"PID_")
bb=InStr(strDeviceName,"MI_")
cc=Left(strDeviceName,3)
if aa>1 and bb<1 and cc="USB" then
strb=strb & strDeviceName & "|"
else
end if
Next
'msgbox strb,,"提示:"
msgbox "现在，请把加密狗插上!",,"提示："
Set colDevices = objWMIService.ExecQuery _
("Select * From Win32_USBControllerDevice")
For Each objDevice in colDevices
strDeviceName = objDevice.Dependent
strQuotes = Chr(34)
strDeviceName = Replace(strDeviceName, strQuotes, "")
arrDeviceNames = Split(strDeviceName, "=")
strDeviceName = arrDeviceNames(1)
Set colUSBDevices = objWMIService.ExecQuery _
("Select * From Win32_PnPEntity Where DeviceID = '" & strDeviceName & "'")
aa=InStr(strDeviceName,"PID_")
bb=InStr(strDeviceName,"MI_")
cc=Left(strDeviceName,3)
if aa>1 and bb<1 and cc="USB" then
strc=strc & strDeviceName & "|"
else
end if
Next
'检测差距
arrstrc = Split(strc,"|")
For Each sss in arrstrc
aa = instr(strb,left(sss,18))
if aa = 0 then
strd = strd & sss & " | "
end if
next
if strd = "" then
msgbox "请按照提示重新操作"
else
msgbox strd,,"提示：截图给我"
end if
'----------------------------------分割线上面的内容复制到记事本把.TXT后缀，改成.VBS运行即可-----------------------
