标题: [问题求助] [已解决]vbs代码,如果双击多次,运行了多次。就可能出现错误。如何避免? [打印本页]
作者: ygqiang 时间: 2015-1-4 15:41 标题: [已解决]vbs代码,如果双击多次,运行了多次。就可能出现错误。如何避免?
本帖最后由 ygqiang 于 2015-1-21 18:47 编辑
vbs代码,如果双击多次,运行了多次。就可能出现错误。如何避免?
保证双击多次vbs,也只运行1次。
可以在vbs代码前面,加入个检测功能:
1、如果存在c:\tt.tt文件,就直接退出。
2、如果不存在,就建立c:\tt.tt文件,并执行后面的vbs代码- Do
- JK
- Loop
-
- '一直检查窗口标题
- Sub JK()
- Dim wso,strTitle
- strTitle = "Microsoft Windows"
- Set wso = CreateObject("Wscript.Shell")
-
- ' 一直检查窗口标题
- Do While wso.AppActivate(strTitle) = False
- WScript.sleep 200 ' 延时 0.2 秒
- Call guan()
- Loop
-
- WScript.Sleep 500 ' 延时 0.5 秒
- Call cunz()
- wso.SendKeys "(%{F4})" ' 发送 Alt + F4
- wso.Run "Explorer.exe /n," '打开我的电脑
- WScript.Sleep 500 ' 延时 0.5 秒
- Call guan()
- Set wso = NoThing
- End Sub
-
-
- '关闭重复窗口
- Sub guan()
- 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
-
-
- '激活窗口
- Sub cunz()
- set wshell = CreateObject("word.Application")
- set wshellw = wshell.tasks
- na="Microsoft Windows"
- If wshellw.Exists(na) Then
- wshellw(na).Activate '激活窗口
- wshellw(na).WindowState = 0 '0平常模式、1最大化模式、2最小化模式
- End If
- End Sub
复制代码
作者: yu2n 时间: 2015-1-4 16:39
- Const strWindowTitle = "Notepad++" ' 监控的窗口标题
-
- Do
- Main
- WScript.Sleep 2000
- Loop
-
- Sub Main()
-
- Dim wso, fso
- Set wso = CreateObject("Wscript.Shell")
- Set fso=CreateObject("Scripting.FileSystemObject")
-
- '检查是否重复运行
- If AppPrevInstance() = True Then
- Msgbox "该程序不允许重复运行!" & vbCrLf & String(75," "), vbOKOnly+vbCritical, WScript.ScriptName
- '直接退出程序
- WScript.Quit(2)
- End If
-
- '一直检查窗口,直到指定窗口出现
- Do While wso.AppActivate(strWindowTitle) = False
- WScript.sleep 200 ' 延时 0.2 秒
- Loop
-
- '激活窗口
- Call WindowActive(strWindowTitle)
-
- '关闭窗口(发送 Alt + F4)
- wso.SendKeys "(%{F4})"
-
- '打开我的电脑
- wso.Run "Explorer.exe /n,"
-
- '关闭重复的文件窗口
- Call CloseRepeatFolderWindow()
-
- Set wso = NoThing
-
- End Sub
-
-
- '一直检查窗口,直到指定窗口出现
- Sub MonitorWindowTitle(ByVal strWindowTitle)
- Dim wso : Set wso = CreateObject("Wscript.Shell")
- Do While wso.AppActivate(strWindowTitle) = False
- WScript.sleep 200 ' 延时 0.2 秒
- Loop
- Set wso = NoThing
- End Sub
-
- '激活窗口
- Sub WindowActive(ByVal strWindowTitle)
- Dim objWord, objTasks
- Set objWord = CreateObject("word.Application")
- Set objTasks = objWord.Tasks
- If objTasks.Exists(strWindowTitle) Then
- objTasks(strWindowTitle).Activate '激活窗口
- objTasks(strWindowTitle).WindowState = 0 '0平常模式、1最大化模式、2最小化模式
- End If
- objWord.Quit
- End Sub
-
- ' 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
-
- '检测是否重复运行
- 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
复制代码
作者: yu2n 时间: 2015-1-4 17:03
版本2,更改了一些逻辑。- Const strWindowTitle = "Notepad++" ' 监控的窗口标题
-
- Do
- Main
- WScript.Sleep 2000
- Loop
-
- Sub Main()
-
- Dim wso, fso
- Set wso = CreateObject("WScript.Shell")
- Set fso = CreateObject("Scripting.FileSystemObject")
-
- '监控并激活窗口
- Call MonitorWindowTitle(strWindowTitle)
-
- '关闭窗口(发送 Alt + F4)
- wso.SendKeys "(%{F4})"
-
- '打开我的电脑
- wso.Run "Explorer.exe /n,"
-
- '关闭重复的文件窗口
- Call CloseRepeatFolderWindow()
-
- Set wso = NoThing
-
- End Sub
-
- '监控并激活窗口
- Sub MonitorWindowTitle(ByVal strWindowTitle)
- Dim wso, objWord, objTasks
- Set wso = CreateObject("Wscript.Shell")
- Set objWord = CreateObject("word.Application")
- Set objTasks = objWord.Tasks
- Do While objTasks.Exists(strWindowTitle) = False
- WScript.sleep 200 ' 延时 0.2 秒
- '检查是否重复运行
- If AppPrevInstance() = True Then
- Call wso.Popup("该程序不允许重复运行!" & vbCrLf & String(75," ") & _
- vbCrLf & "程序将在 3 秒后全部退出 ...", 3, WScript.ScriptName, vbOKOnly+vbCritical)
- '直接退出程序
- objWord.Quit
- WScript.Quit(2)
- End If
- Loop
- Call wso.AppActivate(strWindowTitle) '激活窗口
- objTasks(strWindowTitle).Activate '激活窗口
- objTasks(strWindowTitle).WindowState = 0 '0平常模式、1最大化模式、2最小化模式
- objWord.Quit
- End Sub
-
- ' 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
-
- '检测是否重复运行
- 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
复制代码
作者: 9zhmke 时间: 2015-1-25 00:23
我总感觉应该简单化一点,直接查阅运行程序列表,如果是调用VBS的两个程序名,则查它的参数,看是否与本程序重名,如果重名则退出。
欢迎光临 批处理之家 (http://www.bathome.net/) |
Powered by Discuz! 7.2 |