[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[问题求助] [已解决]如何在监测到u盘插入时,只打开1次“我的电脑”?

本帖最后由 ygqiang 于 2015-1-21 18:33 编辑

[已解决]如何在监测到u盘插入时,只打开1次“我的电脑”?
  1. '后台一直循环2秒监控。
  2. '如果发现u盘插入,就弹出我的电脑
  3. '如果发现有重复标题的文件夹窗口,就自动关闭(只保留1个文件夹窗口)
  4. Do
  5.   Call ufind()
  6.   WScript.Sleep 2000
  7. '关闭重复的文件窗口
  8.   Call CloseRepeatFolderWindow()
  9. Loop
  10. '监控u盘/usb移动硬盘,是否插入
  11. Sub ufind()
  12. dim a
  13. Set wso = CreateObject("WScript.Shell")
  14. Set fso = CreateObject("scripting.filesystemobject")
  15. Set Disks = fso.Drives
  16. For Each Disk In Disks
  17. If Disk.IsReady And Disk.DriveType = 1 Then
  18. 'MsgBox "发现U盘" & Disk.DriveLetter & ":\!", 4096 + 64, "温馨提示"
  19.   '如果u盘插入-自动打开我的电脑
  20.   wso.Run "Explorer.exe /n,"
  21.   '关闭重复的文件窗口
  22.   Call CloseRepeatFolderWindow()
  23. WScript.Sleep 1000
  24. Set wso = NoThing
  25. a=true
  26. End If
  27. Next
  28. if a =false then
  29. 'msgbox "没有发现U盘,请检查U盘是否插好",,"温馨提示"
  30. End if
  31. End Sub
  32. ' VBS关闭重复的文件夹窗口 By Crlf bathome.net
  33. Sub CloseRepeatFolderWindow()
  34.   On Error Resume Next
  35.   Dim Shell, Dict, Wins
  36.   Set Shell = CreateObject("Shell.Application")
  37.   Set Dict = CreateObject("Scripting.Dictionary")
  38.   Set Wins = Shell.Windows
  39.   For i=Wins.Count-1 To 0 step -1
  40.     If Instr(LCase(Wins(i).FullName),"\explorer.exe") Then
  41.       If Dict.Exists(Wins(i).LocationURL) Then
  42.         Wins(i).Quit
  43.       Else
  44.         Dict.Add Wins(i).LocationURL,True
  45.       End If
  46.     End If
  47.   Next
  48. End Sub
复制代码

  1. '后台一直循环2秒监控。
  2. '1、如果发现u盘插入,就弹出我的电脑(每当u盘插入1次,就弹出1次我的电脑,而且只允许弹出1次。下次重新插入u盘,再弹出1次我的电脑)
  3. '2、如果发现有重复标题的文件夹窗口,就自动关闭(只保留1个文件夹窗口)
  4. '上面2个功能是各自独立的、互相之间没有联系的。
  5.   Dim wso, objWord
  6.   Set wso = CreateObject("Wscript.Shell")
  7.   Set objWord = CreateObject("word.Application")
  8.     If AppPrevInstance() = True Then
  9.       Call wso.Popup("该程序不允许重复运行!" & vbCrLf & String(75," ") & _
  10.           vbCrLf & "程序将在 3 秒后全部退出 ...", 3, WScript.ScriptName, vbOKOnly+vbCritical)
  11.       '直接退出程序
  12.       objWord.Quit
  13.       WScript.Quit(2)
  14.     End If
  15. dim TmpDiskNum
  16. TmpDiskNum=0
  17. Do
  18. Call ufind()
  19. WScript.Sleep 2000
  20. '关闭重复的文件窗口
  21. Call CloseRepeatFolderWindow()
  22. Loop
  23. '监控u盘/usb移动硬盘,是否插入
  24. Sub ufind()
  25. On Error Resume Next
  26. dim a
  27. Set fso = CreateObject("scripting.filesystemobject")
  28. Set Disks = fso.Drives
  29. dim DiskNumber
  30. DiskNumber = 0
  31. For Each Disk In Disks
  32. If Disk.IsReady And Disk.DriveType = 1 Then
  33. DiskNumber = DiskNumber + 1
  34. 'MsgBox "发现U盘" & Disk.DriveLetter & ":\!", 4096 + 64, "温馨提示"
  35. '如果u盘插入-自动打开我的电脑
  36. D = Disk.DriveLetter
  37. if DiskNumber > TmpDiskNum then '如果是检测到 但是没有开启过 择开启
  38. dim wso
  39. Set wso = CreateObject("WScript.Shell")
  40. wso.Run "Explorer.exe /n,"
  41. end if
  42. '关闭重复的文件窗口
  43. Call CloseRepeatFolderWindow()
  44. WScript.Sleep 1000
  45. Set wso = NoThing
  46. a = true
  47. End If
  48. Next
  49. TmpDiskNum = DiskNumber
  50. if a = false then
  51. 'U盘不存在
  52. 'msgbox "没有发现U盘,请检查U盘是否插好",,"温馨提示"
  53. End if
  54. End Sub
  55. '检测vbs代码是否重复运行
  56. Function AppPrevInstance()
  57.   AppPrevInstance=False
  58.   Dim objItem, i
  59.   For Each objItem in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  60.     IF LCase(objItem.Name)=LCase(Right(WScript.FullName,11)) Then
  61.       IF InStr(1,objItem.CommandLine,WScript.ScriptFullName,vbTextCompare) > 0 Then i=i+1
  62.     End IF
  63.   Next
  64.   If i>1 Then AppPrevInstance=True
  65. End Function
  66. 'VBS关闭重复的文件夹窗口 By Crlf bathome.net
  67. Sub CloseRepeatFolderWindow()
  68.   On Error Resume Next
  69.   Dim Shell, Dict, Wins
  70.   Set Shell = CreateObject("Shell.Application")
  71.   Set Dict = CreateObject("Scripting.Dictionary")
  72.   Set Wins = Shell.Windows
  73.   For i=Wins.Count-1 To 0 step -1
  74.     If Instr(LCase(Wins(i).FullName),"\explorer.exe") Then
  75.       If Dict.Exists(Wins(i).LocationURL) Then
  76.         Wins(i).Quit
  77.       Else
  78.         Dict.Add Wins(i).LocationURL,True
  79.       End If
  80.     End If
  81.   Next
  82. End Sub
复制代码

TOP

[已解决]最终vbs代码如下:

TOP

返回列表