如何在VBScript上同时运行两个do循环

时间:2017-06-03 21:32:49

标签: vbscript

我正在尝试这样做,因此我的代码一次运行2个循环,因此它可以同时运行开放磁盘驱动器代码和垃圾邮件大写锁定代码。我能以任何方式做到这一点吗?

 Set oWMP = CreateObject("WMPlayer.OCX.7")
Set colCDROMs = oWMP.cdromCollection
x=msgbox("Keyboard error with key CAPS LOCK",0,"Critical Error")
x=msgbox("Error with CD Drive",0,"Critical Error")
Set wshShell =wscript.CreateObject("WScript.Shell")
message= "Critical Disk Drive Error Alert Call Microsoft Support at 0 3 4 4 8 0 0 2 4 0 0 to resolve the issue"
message1= "Caps Lock key Error"
Dim message, sapi
Set sapi=CreateObject("sapi.spvoice")
sapi.Speak message
sapi.Speak message1



do
if colCDROMs.Count >= 1 then
For i = 0 to colCDROMs.Count -1
colCDROMs.Item(i).Eject
Next
For i = 0 to colCDROMs.Count -1
colCDROMs.Item(i).Eject
Next
End If
wscript.sleep 100
wshshell.sendkeys "{CAPSLOCK}"
wscript.sleep 100
loop

1 个答案:

答案 0 :(得分:0)

看一下下面的例子:

CheckTask ' always at the begining of the script

LaunchTask "EjectCdRoms" ' friendly keep CD-ROMs opened
LaunchTask "MsgA" ' friendly show the message A
LaunchTask "MsgB" ' friendly show the message B
LaunchTask "Speak" ' friendly speak

' procedures to be launched asynchronously

Sub EjectCdRoms()
    Dim i
    On Error Resume Next
    Do
        With CreateObject("WMPlayer.OCX.7").cdromCollection
            For i = 0 To .Count - 1
                .Item(d).Eject
            Next
        End With
        WScript.Sleep 500
    Loop
End Sub

Sub MsgA()
    Do
        WScript.Sleep 3000
        MsgBox "Critical Disk Drive Error Alert Call Microsoft Support at 03448002400 to resolve the issue", 48, "Blah"
    Loop
End Sub

Sub MsgB()
    Do
        WScript.Sleep 5000
        MsgBox "Caps Lock key Error", 48, "Blah"
    Loop
End Sub

Sub Speak()
    Do
        With CreateObject("SAPI.SpVoice")
            WScript.Sleep 4000
            .Speak "Critical Disk Drive Error Alert Call Microsoft Support at 0 3 4 4 8 0 0 2 4 0 0 to resolve the issue"
            WScript.Sleep 4000
            .Speak "Caps Lock key Error"
        End With
    Loop
End Sub

' utility procedures, do not modify

Sub CheckTask()
    If WScript.Arguments.Named.Exists("task") Then
        On Error Resume Next
        Execute WScript.Arguments.Named.Item("task")
        WScript.Quit
    End If
End Sub

Sub LaunchTask(sTaskName)
    CreateObject("WScript.Shell").Exec """" & WScript.FullName & """ """ & WScript.ScriptFullName & """ ""/task:" & sTaskName & """"
End Sub