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

[问题求助] [已解决]vbs后台一直循环2秒监控。如果发现u盘插入,就弹出我的电脑。如何实现?

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

[已解决]vbs后台一直循环2秒监控。如果发现u盘插入,就弹出我的电脑。如何实现?
如果发现有重复标题的文件夹窗口,就自动关闭(只保留1个文件夹窗口)
  1. '关闭重复窗口、u盘插入-自动打开我的电脑
  2. '
  3. '后台一直循环2秒监控。
  4. '如果发现u盘插入,就弹出我的电脑
  5. '如果发现有重复标题的文件夹窗口,就自动关闭(只保留1个文件夹窗口)
  6. Do
  7.   Main
  8.   WScript.Sleep 2000
  9. Loop
  10. Sub Main()
  11.   Dim wso, fso
  12.   Set wso = CreateObject("WScript.Shell")
  13.   Set fso = CreateObject("Scripting.FileSystemObject")
  14.   
  15.   '监控u盘/usb移动硬盘,是否插入
  16.   
  17.   '如果u盘插入-自动打开我的电脑
  18.   wso.Run "Explorer.exe /n,"
  19.   '关闭重复的文件窗口
  20.   Call CloseRepeatFolderWindow()
  21.   
  22.   Set wso = NoThing
  23.   
  24. End Sub
  25. '监控u盘/usb移动硬盘,是否插入
  26. Sub Monitor-U()
  27. End Sub
  28. ' VBS关闭重复的文件夹窗口 By Crlf bathome.net
  29. Sub CloseRepeatFolderWindow()
  30.   On Error Resume Next
  31.   Dim Shell, Dict, Wins
  32.   Set Shell = CreateObject("Shell.Application")
  33.   Set Dict = CreateObject("Scripting.Dictionary")
  34.   Set Wins = Shell.Windows
  35.   For i=Wins.Count-1 To 0 step -1
  36.     If Instr(LCase(Wins(i).FullName),"\explorer.exe") Then
  37.       If Dict.Exists(Wins(i).LocationURL) Then
  38.         Wins(i).Quit
  39.       Else
  40.         Dict.Add Wins(i).LocationURL,True
  41.       End If
  42.     End If
  43.   Next
  44. End Sub
  45. '检测vbs代码是否重复运行
  46. Function AppPrevInstance()
  47.   AppPrevInstance=False
  48.   Dim objItem, i
  49.   For Each objItem in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  50.     IF LCase(objItem.Name)=LCase(Right(WScript.FullName,11)) Then
  51.       IF InStr(1,objItem.CommandLine,WScript.ScriptFullName,vbTextCompare) > 0 Then i=i+1
  52.     End IF
  53.   Next
  54.   If i>1 Then AppPrevInstance=True
  55. End Function
复制代码

  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

  1. '监控
  2. Sub MonitorWindowTitle(ByVal strWindowTitle)
  3.   Dim wso, objWord, objTasks
  4.   Set wso = CreateObject("Wscript.Shell")
  5.   Set objWord = CreateObject("word.Application")
  6.   Set objTasks = objWord.Tasks
  7.   Do While objTasks.Exists(strWindowTitle) = False
  8.     WScript.sleep 200    ' 延时 0.2 秒
  9.     Call CloseRepeatFolderWindow()
  10.     '检查是否重复运行
  11.     If AppPrevInstance() = True Then
  12.       Call wso.Popup("该程序不允许重复运行!" & vbCrLf & String(75," ") & _
  13.           vbCrLf & "程序将在 3 秒后全部退出 ...", 3, WScript.ScriptName, vbOKOnly+vbCritical)
  14.       '直接退出程序
  15.       objWord.Quit
  16.       WScript.Quit(2)
  17.     End If
  18.   Loop
  19. End Sub
复制代码

TOP

返回列表