run msgbox in background VBscript

jeffpkamp Source

Two part question:

  1. I am trying to write a VBscript where a loop runs, but there is a message box that the user can use to abort the sequence at anytime. I know that if you have a sequence with msgbox in it, the script will stop executing until an answer has been received, but can I run it as a subscript, so it doesn't interfere with the main script?

when I use the following script, I never see the msgbox

function test()
msgbox ("test")
end function
wscript.sleep 1000
msgbox "done

i was under the impression that function let you get inputs. Can this even be done with pure vbscript?

functionvbscriptmsgbox

Answers

answered 5 years ago jeffpkamp #1

Not what I was going for but this is a work around I found. It makes a temporary msgbox that closes itself after a time. Gives the user a 5 second window to abort the sequence each loop.

set infobox = createobject("Wscript.shell")
do while E<N+1
    E=E+1
    if InfoBox.Popup ("Click cancel to stop sequence", _ 
            5, "Abort Sequence?", 1) = 2 then
            E=N+1
    end if
    loop

answered 5 years ago B Hart #2

The Trick here is to have the first script create and start a second script. This second script will just run in the background and can then wait and kill the initial script Process... This can easily be done with a Function and can be called at the start of your script. When your main script ends, it simply kills the previously created second script. Note: the second script which is created will automatically delete itself upon being run. See the below Script for a good working example:

Dim iKillPID

'Start Kill Script At Start Of Script
iKillPID = KillPID()

For X = 10 To 0 Step -1
    WScript.Echo "Closing in " & X & " Seconds"
    WScript.Sleep 1000
Next

'Kill The Kill Script At End Of Script
GetObject("winmgmts:root\cimv2:Win32_Process.Handle='" & iKillPID & "'").Terminate
MsgBox "This Script is Complete"

'$$$$$$$$$$
Function KillPID()
Dim strKillScriptPath, strKillCommand, KillFile, StrFileKill, iScriptPID
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Generates a Unique Temp File Name In The Same Directory As The Current Script
strKillScriptPath = objFSO.GetParentFolderName(WScript.ScriptFullName) & Chr(92) & Replace(objFSO.GetTempName, ".tmp", ".vbs")
    'Command Line To New Kill Script
strKillCommand = "WScript.exe " & Chr(34) & strKillScriptPath & Chr(34)
    'This part gets the Process ID of the Current Running Script
iScriptPID = GetObject("winmgmts:root\cimv2:Win32_Process.Handle='" & _
 CreateObject("WScript.Shell").Exec("CMD /C ping 127.0.0.1 -n 2 > nul").ProcessID & "'").ParentProcessID
    'String With Kill File Code (Script Process ID Included)
StrFileKill = _
"Const iKillProc = " & iScriptPID & vbCrLf & _
"Dim objFSO: Set objFSO = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ")" & vbCrLf & _
"objFSO.DeleteFile WScript.ScriptFullName, True" & vbCrLf & _  '<-- Deletes itself immediately upon running
"On Error Resume Next" & vbCrLf & _
"Set objKillProc = Nothing" & vbCrLf & _
"Set objKillProc = GetObject(" & Chr(34) & "winmgmts:root\cimv2:Win32_Process.Handle='" & Chr(34) & " & iKillProc & " & Chr(34) & "'" & Chr(34) & ")" & vbCrLf & _
"If objKillProc Is Nothing Then" & vbCrLf & _
"    MsgBox " & Chr(34) & "The Process Is Not Running" & Chr(34) & vbCrLf & _
"    WScript.Quit" & vbCrLf & _
"End If" & vbCrLf & _
"MsgBox " & Chr(34) & "Click OK To Kill The Script Process" & Chr(34) & vbCrLf & _
"Call KillProcess(iKillProc)" & vbCrLf & _
"WScript.Quit" & vbCrLf & _
"Sub KillProcess(iProcID)" & vbCrLf & _
"Dim objKillProc, strParentProc" & vbCrLf & _
"On Error Resume Next" & vbCrLf & _
"Set objKillProc = Nothing" & vbCrLf & _
"Set objKillProc = GetObject(" & Chr(34) & "winmgmts:root\cimv2:Win32_Process.Handle='" & Chr(34) & " & iProcID & " & Chr(34) & "'" & Chr(34) & ")" & vbCrLf & _
"If Err = 0 And Not objKillProc Is Nothing Then" & vbCrLf & _
"    If StrComp(objKillProc.Name, " & Chr(34) & "cmd.exe" & Chr(34) & ", 1) = 0 Or _" & vbCrLf & _
"     StrComp(objKillProc.Name, " & Chr(34) & "cscript.exe" & Chr(34) & ", 1) = 0 Or _" & vbCrLf & _
"     StrComp(objKillProc.Name, " & Chr(34) & "wscript.exe" & Chr(34) & ", 1) = 0 Then" & vbCrLf & _
"        strParentProc = objKillProc.ParentProcessID" & vbCrLf & _
"        objKillProc.Terminate()" & vbCrLf & _
"    Call KillProcess(strParentProc)" & vbCrLf & _
"    End If" & vbCrLf & _
"End If" & vbCrLf & _
"Set strParentProc = Nothing" & vbCrLf & _
"Err.Clear" & vbCrLf & _
"End Sub"
    'Write the Code To File
Set KillFile = objFSO.CreateTextFile(strKillScriptPath, True)
KillFile.WriteLine StrFileKill
KillFile.Close
Set KillFile = Nothing
WScript.Sleep 250
    'Execute The Script and Return the Script Process ID So You Can Kill It When The Script Ends
KillPID = CreateObject("WScript.Shell").Exec(strKillCommand).ProcessID
End Function
'$$$$$$$$$$

Also, If you're using CScript as the Scripting Engine for your VBS, I believe you can stop the script by pressing CTRL + C in the Command Prompt Window.

Now if your super motivated you can create an HTA that does about the same thing, but present a UserForm or Custom Internet Explorer Window to click and it can also loop through and check if the process is still running and close itself when the script is finished and the process is no longer running. You can add pretty colors and everything too!

comments powered by Disqus