Board logo

标题: [问题求助] [已解决]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代码
  1. Do
  2.   JK
  3. Loop
  4. '一直检查窗口标题
  5. Sub JK()
  6.   Dim wso,strTitle
  7.   strTitle = "Microsoft Windows"
  8.   Set wso = CreateObject("Wscript.Shell")
  9.   ' 一直检查窗口标题
  10.   Do While wso.AppActivate(strTitle) = False
  11.     WScript.sleep 200    ' 延时 0.2 秒
  12.     Call guan()
  13.   Loop
  14.   WScript.Sleep 500       ' 延时 0.5 秒
  15.   Call cunz()
  16.   wso.SendKeys "(%{F4})"   ' 发送 Alt + F4
  17.   wso.Run "Explorer.exe /n," '打开我的电脑
  18.   WScript.Sleep 500       ' 延时 0.5 秒
  19.   Call guan()
  20.   Set wso = NoThing
  21. End Sub
  22. '关闭重复窗口
  23. Sub guan()
  24.     Set Shell = CreateObject("Shell.Application")
  25.     Set Dict = CreateObject("Scripting.Dictionary")
  26.     Set Wins = Shell.Windows
  27.     For i=Wins.Count-1 To 0 step -1
  28.         If Instr(LCase(Wins(i).FullName),"\explorer.exe") Then
  29.             If Dict.Exists(Wins(i).LocationURL) Then
  30.                 Wins(i).Quit
  31.             Else
  32.                 Dict.Add Wins(i).LocationURL,True
  33.             End If
  34.         End If
  35.     Next
  36. End Sub
  37. '激活窗口
  38. Sub cunz()
  39.     set wshell = CreateObject("word.Application")
  40.     set wshellw = wshell.tasks
  41.     na="Microsoft Windows"
  42.     If wshellw.Exists(na) Then
  43.        wshellw(na).Activate         '激活窗口
  44.        wshellw(na).WindowState = 0  '0平常模式、1最大化模式、2最小化模式
  45.     End If
  46. End Sub
复制代码

作者: yu2n    时间: 2015-1-4 16:39

  1. Const strWindowTitle = "Notepad++"   ' 监控的窗口标题
  2. Do
  3.   Main
  4.   WScript.Sleep 2000
  5. Loop
  6. Sub Main()
  7.   Dim wso, fso
  8.   Set wso = CreateObject("Wscript.Shell")
  9.   Set fso=CreateObject("Scripting.FileSystemObject")
  10.   
  11.   '检查是否重复运行
  12.   If AppPrevInstance() = True Then
  13.     Msgbox "该程序不允许重复运行!" & vbCrLf & String(75," "), vbOKOnly+vbCritical, WScript.ScriptName
  14.     '直接退出程序
  15.     WScript.Quit(2)
  16.   End If
  17.   
  18.   '一直检查窗口,直到指定窗口出现
  19.   Do While wso.AppActivate(strWindowTitle) = False
  20.     WScript.sleep 200    ' 延时 0.2 秒
  21.   Loop
  22.   
  23.   '激活窗口
  24.   Call WindowActive(strWindowTitle)
  25.   
  26.   '关闭窗口(发送 Alt + F4)
  27.   wso.SendKeys "(%{F4})"
  28.   
  29.   '打开我的电脑
  30.   wso.Run "Explorer.exe /n,"
  31.   '关闭重复的文件窗口
  32.   Call CloseRepeatFolderWindow()
  33.   
  34.   Set wso = NoThing
  35.   
  36. End Sub
  37. '一直检查窗口,直到指定窗口出现
  38. Sub MonitorWindowTitle(ByVal strWindowTitle)
  39.   Dim wso : Set wso = CreateObject("Wscript.Shell")
  40.   Do While wso.AppActivate(strWindowTitle) = False
  41.     WScript.sleep 200    ' 延时 0.2 秒
  42.   Loop
  43.   Set wso = NoThing
  44. End Sub
  45. '激活窗口
  46. Sub WindowActive(ByVal strWindowTitle)
  47.   Dim objWord, objTasks
  48.   Set objWord = CreateObject("word.Application")
  49.   Set objTasks = objWord.Tasks
  50.   If objTasks.Exists(strWindowTitle) Then
  51.     objTasks(strWindowTitle).Activate         '激活窗口
  52.     objTasks(strWindowTitle).WindowState = 0  '0平常模式、1最大化模式、2最小化模式
  53.   End If
  54.   objWord.Quit
  55. End Sub
  56. ' VBS关闭重复的文件夹窗口 By Crlf bathome.net
  57. Sub CloseRepeatFolderWindow()
  58.   On Error Resume Next
  59.   Dim Shell, Dict, Wins
  60.   Set Shell = CreateObject("Shell.Application")
  61.   Set Dict = CreateObject("Scripting.Dictionary")
  62.   Set Wins = Shell.Windows
  63.   For i=Wins.Count-1 To 0 step -1
  64.     If Instr(LCase(Wins(i).FullName),"\explorer.exe") Then
  65.       If Dict.Exists(Wins(i).LocationURL) Then
  66.         Wins(i).Quit
  67.       Else
  68.         Dict.Add Wins(i).LocationURL,True
  69.       End If
  70.     End If
  71.   Next
  72. End Sub
  73. '检测是否重复运行
  74. Function AppPrevInstance()
  75.   AppPrevInstance=False
  76.   Dim objItem, i
  77.   For Each objItem in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  78.     IF LCase(objItem.Name)=LCase(Right(WScript.FullName,11)) Then
  79.       IF InStr(1,objItem.CommandLine,WScript.ScriptFullName,vbTextCompare) > 0 Then i=i+1
  80.     End IF
  81.   Next
  82.   If i>1 Then AppPrevInstance=True
  83. End Function
复制代码

作者: yu2n    时间: 2015-1-4 17:03

版本2,更改了一些逻辑。
  1. Const strWindowTitle = "Notepad++"   ' 监控的窗口标题
  2. Do
  3.   Main
  4.   WScript.Sleep 2000
  5. Loop
  6. Sub Main()
  7.   Dim wso, fso
  8.   Set wso = CreateObject("WScript.Shell")
  9.   Set fso = CreateObject("Scripting.FileSystemObject")
  10.   
  11.   '监控并激活窗口
  12.   Call MonitorWindowTitle(strWindowTitle)
  13.   
  14.   '关闭窗口(发送 Alt + F4)
  15.   wso.SendKeys "(%{F4})"
  16.   
  17.   '打开我的电脑
  18.   wso.Run "Explorer.exe /n,"
  19.   '关闭重复的文件窗口
  20.   Call CloseRepeatFolderWindow()
  21.   
  22.   Set wso = NoThing
  23.   
  24. End Sub
  25. '监控并激活窗口
  26. Sub MonitorWindowTitle(ByVal strWindowTitle)
  27.   Dim wso, objWord, objTasks
  28.   Set wso = CreateObject("Wscript.Shell")
  29.   Set objWord = CreateObject("word.Application")
  30.   Set objTasks = objWord.Tasks
  31.   Do While objTasks.Exists(strWindowTitle) = False
  32.     WScript.sleep 200    ' 延时 0.2 秒
  33.     '检查是否重复运行
  34.     If AppPrevInstance() = True Then
  35.       Call wso.Popup("该程序不允许重复运行!" & vbCrLf & String(75," ") & _
  36.           vbCrLf & "程序将在 3 秒后全部退出 ...", 3, WScript.ScriptName, vbOKOnly+vbCritical)
  37.       '直接退出程序
  38.       objWord.Quit
  39.       WScript.Quit(2)
  40.     End If
  41.   Loop
  42.   Call wso.AppActivate(strWindowTitle)      '激活窗口
  43.   objTasks(strWindowTitle).Activate         '激活窗口
  44.   objTasks(strWindowTitle).WindowState = 0  '0平常模式、1最大化模式、2最小化模式
  45.   objWord.Quit
  46. End Sub
  47. ' VBS关闭重复的文件夹窗口 By Crlf bathome.net
  48. Sub CloseRepeatFolderWindow()
  49.   On Error Resume Next
  50.   Dim Shell, Dict, Wins
  51.   Set Shell = CreateObject("Shell.Application")
  52.   Set Dict = CreateObject("Scripting.Dictionary")
  53.   Set Wins = Shell.Windows
  54.   For i=Wins.Count-1 To 0 step -1
  55.     If Instr(LCase(Wins(i).FullName),"\explorer.exe") Then
  56.       If Dict.Exists(Wins(i).LocationURL) Then
  57.         Wins(i).Quit
  58.       Else
  59.         Dict.Add Wins(i).LocationURL,True
  60.       End If
  61.     End If
  62.   Next
  63. End Sub
  64. '检测是否重复运行
  65. Function AppPrevInstance()
  66.   AppPrevInstance=False
  67.   Dim objItem, i
  68.   For Each objItem in GetObject("winmgmts:\\.\root\cimv2:win32_process").instances_
  69.     IF LCase(objItem.Name)=LCase(Right(WScript.FullName,11)) Then
  70.       IF InStr(1,objItem.CommandLine,WScript.ScriptFullName,vbTextCompare) > 0 Then i=i+1
  71.     End IF
  72.   Next
  73.   If i>1 Then AppPrevInstance=True
  74. End Function
复制代码

作者: 9zhmke    时间: 2015-1-25 00:23

我总感觉应该简单化一点,直接查阅运行程序列表,如果是调用VBS的两个程序名,则查它的参数,看是否与本程序重名,如果重名则退出。




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2