- '后台一直循环2秒监控。
- '1、如果发现u盘插入,就弹出我的电脑(每当u盘插入1次,就弹出1次我的电脑,而且只允许弹出1次。下次重新插入u盘,再弹出1次我的电脑)
- '2、如果发现有重复标题的文件夹窗口,就自动关闭(只保留1个文件夹窗口)
- '上面2个功能是各自独立的、互相之间没有联系的。
-
- Dim wso, objWord
- Set wso = CreateObject("Wscript.Shell")
- Set objWord = CreateObject("word.Application")
-
- If AppPrevInstance() = True Then
- Call wso.Popup("该程序不允许重复运行!" & vbCrLf & String(75," ") & _
- vbCrLf & "程序将在 3 秒后全部退出 ...", 3, WScript.ScriptName, vbOKOnly+vbCritical)
- '直接退出程序
- objWord.Quit
- WScript.Quit(2)
- End If
-
-
- dim TmpDiskNum
- TmpDiskNum=0
- Do
- Call ufind()
- WScript.Sleep 2000
- '关闭重复的文件窗口
- Call CloseRepeatFolderWindow()
- Loop
-
- '监控u盘/usb移动硬盘,是否插入
- Sub ufind()
- On Error Resume Next
- dim a
- Set fso = CreateObject("scripting.filesystemobject")
- Set Disks = fso.Drives
- dim DiskNumber
- DiskNumber = 0
-
- For Each Disk In Disks
- If Disk.IsReady And Disk.DriveType = 1 Then
-
- DiskNumber = DiskNumber + 1
-
- 'MsgBox "发现U盘" & Disk.DriveLetter & ":\!", 4096 + 64, "温馨提示"
- '如果u盘插入-自动打开我的电脑
- D = Disk.DriveLetter
-
- if DiskNumber > TmpDiskNum then '如果是检测到 但是没有开启过 择开启
- dim wso
- Set wso = CreateObject("WScript.Shell")
- wso.Run "Explorer.exe /n,"
- end if
-
- '关闭重复的文件窗口
- Call CloseRepeatFolderWindow()
- WScript.Sleep 1000
- Set wso = NoThing
- a = true
- End If
- Next
-
- TmpDiskNum = DiskNumber
-
- if a = false then
- 'U盘不存在
- 'msgbox "没有发现U盘,请检查U盘是否插好",,"温馨提示"
- End if
-
- End Sub
-
-
- '检测vbs代码是否重复运行
- Function AppPrevInstance()
- AppPrevInstance=False
- Dim objItem, i
- For Each objItem in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
- IF LCase(objItem.Name)=LCase(Right(WScript.FullName,11)) Then
- IF InStr(1,objItem.CommandLine,WScript.ScriptFullName,vbTextCompare) > 0 Then i=i+1
- End IF
- Next
- If i>1 Then AppPrevInstance=True
- End Function
-
-
-
- 'VBS关闭重复的文件夹窗口 By Crlf bathome.net
- Sub CloseRepeatFolderWindow()
- On Error Resume Next
- Dim Shell, Dict, Wins
- Set Shell = CreateObject("Shell.Application")
- Set Dict = CreateObject("Scripting.Dictionary")
- Set Wins = Shell.Windows
- For i=Wins.Count-1 To 0 step -1
- If Instr(LCase(Wins(i).FullName),"\explorer.exe") Then
- If Dict.Exists(Wins(i).LocationURL) Then
- Wins(i).Quit
- Else
- Dict.Add Wins(i).LocationURL,True
- End If
- End If
- Next
- End Sub
复制代码
|