Yes/no shut down - vbscript

I am playing with VBScript and I want to make a MsgBox which asks the user if they want to shut down their computer or not.
If the user clicks Yes they should see a MsgBox first then their computer starts to shutdown.
I am using this code but it doesn't work.
What is the problem?
result = MsgBox ("Shutdown?", vbYesNo, "Yes/No Exm")
Select Case result
Case vbYes
MsgBox("shuting down ...")
Option Explicit
Dim objShell
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 0"
Case vbNo
MsgBox("Ok")
End Select

I have amended your code as per below:
Option Explicit
Dim result
result = MsgBox ("Shutdown?", vbYesNo, "Yes/No Exm")
Select Case result
Case vbYes
MsgBox("shuting down ...")
Dim objShell
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 20"
Case vbNo
MsgBox("Ok")
End Select
The main issues were that "option explicit" has to be at the top, and as a result the "result" variable then must be declared using the "dim" keyword. The above code works fine when I executed it via the command line.
I also added a timeout of 20, but you can easily change this back to the original value of 0.

As documented Option Explicit must appear before any other statement in a script. Using it anywhere else in a script should raise a "Expected Statement" error pointing to the line with the Option Explicit statement. If you don't get that error, you have an On Error Resume Next in your code that you didn't show.
If you move the Option Explicit statement to the beginning of the script, but the shutdown still doesn't occur, you need to check the return value of the shutdown command:
rc = objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 0", 0, True
If rc <> 0 Then MsgBox "shutdown failed with exit code " & rc & "."
The parentheses in your MsgBox statements shouldn't cause an issue as long as you pass just a single argument to the function, but I'd still remove them.

Try This:
Set Shell = CreateObject("WScript.Shell")
Answer = MsgBox("Do You Want To" & vbNewLine & "Shut Down Your Computer?",vbYesNo,"Shutdown:")
If Answer = vbYes Then
Shell.run "shutdown.exe -s -t 60"
Ending = 1
ElseIf Answer = vbNo Then
Stopping = MsgBox("Do You Wish To Quit?",vbYesNo,"Quit:")
If Stopping = vbYes Then
WScript.Quit 0
End If
End If

Related

VBScript's Shell Command Will Not Execute Unless An Output File Is Specified

I'm trying to run a shell command for google speech recognition. I'm able to run the command only if I provide an output file to the command string.
As you can see my test code sample below, I would attach the ">outputFile" if one is provided and also coded in a timeout loop to abort the process after a set time limit.
strCommand = "cmd /c ipconfig /all"
If outputFile <> "" Then
strCommand = strCommand & " > """ & outputFile & """"
End If
Set wshShellExec = wshShell.Exec(strCommand)
expiration = DateAdd("s", 600, Now)
Do While wshShellExec.Status = WshRunning And Now < expiration
WScript.Sleep 5000
Loop
Select Case wshShellExec.Status
Case WshRunning
wshShellExec.Terminate
TestFunction = "{""error"": ""TestFunction Command Timed Out""}"
Case WshFinished
TestFunction = WshShellExec.StdOut.ReadAll()
Case WshFailed
TestFunction = wshShellExec.StdErr.ReadAll()
End Select
If I leave outputFile empty and try to expect the output to be returned from the function, all it does is sit still for 5 minutes before timing out and sending me my error message.
Why does it need an output file to run?
If I run the command line manually on a Command Prompt, it runs perfectly fine.
Output buffers have limited capacity. If your command writes too much text to stdout the buffer will fill up and block the command from writing more until you clear the buffer (e.g. by reading from it). ReadAll can't be used for that, though, because that method will only return after the command has finished and block otherwise, thus creating a deadlock.
Your best option is to redirect output to one or more (temp) files, and read the output from those files after the command has finished.
outfile = "C:\out.txt"
errfile = "C:\err.txt"
cmd = "cmd /c ipconfig /all >""" & outfile & """ 2>""" & errfile & """"
timeout = DateAdd("s", 600, Now)
Set sh = CreateObject("WScript.Shell")
Set ex = sh.Exec(cmd)
Do While ex.Status = WshRunning And Now < timeout
WScript.Sleep 200
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
outtxt = fso.OpenTextFile(outfile).ReadAll
errtxt = fso.OpenTextFile(errfile).ReadAll
If you don't want to do that for some reason you must read from StdOut repeatedly.
outtxt = ""
errtxt = ""
cmd = "ipconfig /all"
timeout = DateAdd("s", 600, Now)
Set sh = CreateObject("WScript.Shell")
Set ex = sh.Exec(cmd)
Do While ex.Status = WshRunning And Now < timeout
WScript.Sleep 200
outtxt = outtxt & ex.StdOut.ReadLine & vbNewLine
Loop
Note that you may also need to read from StdErr, because that buffer might fill up too if there is too much error output. However, reading both buffers might create another deadlock, because IIRC ReadLine blocks until it can read a full line, so if the script might hang waiting for error output that never appears. You might be able to work around that by using Read instead of ReadLine, but it'll still be very fragile.
So, again, your best option is to redirect command output to files and read those files after the command terminates.
Once the wshShellExec is terminated in the WshRunning case, instead of assigning the error message, the output should be assigned.
Select Case wshShellExec.Status
Case WshRunning
wshShellExec.Terminate
TestFunction = "Terminated: " & vbcrlf & WshShellExec.StdOut.ReadAll()
Case WshFinished
TestFunction = "Finished: " & vbcrlf & WshShellExec.StdOut.ReadAll()
Case WshFailed
TestFunction = wshShellExec.StdErr.ReadAll()
End Select

returning error code to VBScript

Here is what I am trying to do:
Get a VBScript to run another VBScript.
get the second VBScript to post an error on completion, either 0 if successful or >0 if not back to the original script and then work on conditions Based on the error code returned.
Uninstall 2010 & copy office 2013
'Copy files from a network share to machine
Set FSO = CreateObject("Scripting.FileSystemObject")
WScript.Echo "Starting to uninstall Microsoft Office 2010 from the machine"
FSO.CopyFile "\\data01\Tools\WSM\Copy_2013.vbs", "C:\temp\Copy_2013.vbs"
FSO.CopyFile "\\data01\Tools\WSM\OffScrub10.vbs", "C:\Temp\OffScrub10.vbs"
FSO.CopyFile "\\data01\Tools\WSM\DeleteOffice13Package.vbs", "C:\temp\DeleteOffice13Package.vbs"
'Wait to execute rest of script where copied filed need to be in location
WScript.Sleep 5000
'Executes Office 2013 copy at the same time, do not wait to continue uninstalling office 2010
Set objShell = WScript.CreateObject("WScript.Shell")
Call objShell.Run("C:\temp\Copy_2013.vbs", 0, False)
WScript.Sleep 3000
'Run VBScript that uninstalls office 2010 (currently set to copy a non existent path for error capture test)
strRemoveOffice10 = "c:\Temp\offscrub10.vbs ALL /Quiet /NoCancel"
Call objShell.Run(strRemoveOffice10, 0, True)
WScript.Echo Err.Number
If Err.Number <> 0 Then WScript.Echo " Microsoft Office 2010 could not be uninstalled. Please uninstall again manually."
If Err.Number = 0 Then WScript.Echo "Microsoft Office 2010 has uninstalled from the machine"
Set objFileSys = Nothing
WScript.Quit
OffScrub10.vbs
Dim objFileSys
Set objFileSys = CreateObject("Scripting.FileSystemObject")
objFileSys.GetFolder("C:\Temp\Temp1\bla").Copy "C:\WSM\Test"
On Error Resume Next
If Err.Number <> 0 WScript.Quit Err
To enable error handling you need to put On Error Resume Next before the statement that may cause an error. Then you can return a status code like this:
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fso.GetFolder("C:\Temp\Temp1\bla").Copy "C:\WSM\Test"
WScript.Quit Err.Number
However, since you said you want a return value >0 in case of an error and Err.Number is an unsigned integer that might be interpreted as a positive or negative value depending on its actual value, something like this might be a better choice:
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fso.GetFolder("C:\Temp\Temp1\bla").Copy "C:\WSM\Test"
If Err Then WScript.Quit 1
WScript.Quit 0 'can be omitted, because it's the default
To check the returned value in the calling script you need to capture it in a variable. When using the Call statement like you do in your first script the return value is simply discarded. VBScript does not put return values of external commands in the Err object. You may also want to make sure that your script is being run with cscript.exe to avoid messages/popups blocking execution.
strRemoveOffice10 = "cscript.exe c:\Temp\offscrub10.vbs ALL /Quiet /NoCancel"
rc = objShell.Run(strRemoveOffice10, 0, True)
If rc = 0 Then
'OK
Else
'an error occurred
End If
Yes, you can return an exit code from your second script to the first as follows...
WScript.Quit(-1)
Where -1 is your exit code of choice.
Option Explicit
If WScript.Arguments.Count = 0 Then
' If we don't have any arguments, call ourselves to retrieve
' the exit code. It will be returned by the call to the
' Run method
Dim returnCode
returnCode = WScript.CreateObject("WScript.Shell").Run ( _
Chr(34) & WScript.ScriptFullName & Chr(34) & " myArgument " _
, 0 _
, True _
)
' Note ^ the "True"
' We need to wait for the "subprocess" to end to retrieve the exit code
Call WScript.Echo(CStr( returnCode ))
Else
' We have arguments, leave current process with exit code
Call WScript.Quit( 1234 )
End If
Quick sample for testing.
There are two elements to consider:
The called subprocess uses the WScript.Quit method to return the process exit code to the caller
The caller must wait for the subprocess to end to retrieve the exit code. The Run method will return the exit code of the subprocess

VBSript Shutdown Message Confusion

I am currently learning how to write commands in Visual Basic and decided to make a simple shutdown message. The code worked perfectly: when the user clicked 'yes' it shutdown and 'no', 'cancel' and the 'X' button closed the message.
However, I decided to try a make a prank message aswell, where the computer would shutdown whatever option was chosen. I ran the script, however when I clicked the 'X' icon (I did not fancy the idea of shutting down my computer!), my computer shutdown anyway :(
Is there a way to stop this happening, or, even better, is there a way to grey out the 'X' icon so the user cannot close the message?
Here is the code:
Option Explicit
Dim result
result = MsgBox ("Do you want to shutdown?", 3+48,"Warning")
Dim objShell
Select Case result
Case vbYes
MsgBox("shuting down ...")
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 20"
Case vbNo
MsgBox("shuting down ...")
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 20"
Case vbCancel
MsgBox("shuting down ...")
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 20"
End Select
Cheers in advance! :D
-r : for reboot
-s : for shutdown
This Vbscript can create a shortcut on your desktop asking you if you want to shutdown the computer or not.
Option Explicit
Dim MyScriptPath
MyScriptPath = WScript.ScriptFullName
Call Shortcut(MyScriptPath,"Shutdown the computer")
Call AskQuestion()
'**********************************************************************************************
Sub Shortcut(PathApplication,Name)
Dim objShell,DesktopPath,objShortCut,MyTab
Set objShell = CreateObject("WScript.Shell")
MyTab = Split(PathApplication,"\")
If Name = "" Then
Name = MyTab(UBound(MyTab))
End if
DesktopPath = objShell.SpecialFolders("Desktop")
Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & Name & ".lnk")
objShortCut.TargetPath = Dblquote(PathApplication)
ObjShortCut.IconLocation = "%SystemRoot%\system32\SHELL32.dll,-28"
objShortCut.Save
End Sub
'**********************************************************************************************
Sub AskQuestion()
Dim Question,Msg,Title
Title = "Shutdown the computer"
Msg = "Are you sure to shutdown the computer now ?"& Vbcr &_
"If yes, then click [YES] button "& Vbcr &_
"If not, then click [NO] button"
Question = MsgBox (Msg,VbYesNo+VbQuestion,Title)
If Question = VbYes then
Call Run_Shutdown(30)
else
WScript.Quit()
End if
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Run_Shutdown(N)
Dim ws,Command,Execution
Set ws = CreateObject("wscript.Shell")
Command = "Cmd /c Shutdown -s -t "& N &" -c "& DblQuote("Save your work because your PC will shut down in "& N &" seconds")
Execution = ws.run(Command,0,True)
End sub
'**********************************************************************************************
Ok, is there a reason for trying to remove/disable the X? I ask because it will be kinda difficult though it can be done.
Not all button combinations on the msgbox enable the X. Try vbAbortRetryIgnore and also try vbYesNo.
If a Cancel button is provided (all other combinations except vbOkOnly) then X is enabled
If only one button is displayed then X is enabled
This really makes it almost pointless to disable the button once you are aware of these things. Here's what happens when the above scenarios are displayed an user hits X vs clicking on a button
N/A. X button not enabled
MsgBox returns vbCancel
MsgBox returns value of only button
By the way, it is not just clicking X. When X is enabled, ESC will trigger same results.

WScript.Shell.Exec - read output from stdout

My VBScript does not show the results of any command I execute. I know the command gets executed but I would like to capture the result.
I have tested many ways of doing this, for example the following:
Const WshFinished = 1
Const WshFailed = 2
strCommand = "ping.exe 127.0.0.1"
Set WshShell = CreateObject("WScript.Shell")
Set WshShellExec = WshShell.Exec(strCommand)
Select Case WshShellExec.Status
Case WshFinished
strOutput = WshShellExec.StdOut.ReadAll
Case WshFailed
strOutput = WshShellExec.StdErr.ReadAll
End Select
WScript.StdOut.Write strOutput 'write results to the command line
WScript.Echo strOutput 'write results to default output
But it does not print any results. How do I capture StdOut and StdErr?
WScript.Shell.Exec() returns immediately, even though the process it starts does not. If you try to read Status or StdOut right away, there won't be anything there.
The MSDN documentation suggests using the following loop:
Do While oExec.Status = 0
WScript.Sleep 100
Loop
This checks Status every 100ms until it changes. Essentially, you have to wait until the process completes, then you can read the output.
With a few small changes to your code, it works fine:
Const WshRunning = 0
Const WshFinished = 1
Const WshFailed = 2
strCommand = "ping.exe 127.0.0.1"
Set WshShell = CreateObject("WScript.Shell")
Set WshShellExec = WshShell.Exec(strCommand)
Do While WshShellExec.Status = WshRunning
WScript.Sleep 100
Loop
Select Case WshShellExec.Status
Case WshFinished
strOutput = WshShellExec.StdOut.ReadAll()
Case WshFailed
strOutput = WshShellExec.StdErr.ReadAll()
End Select
WScript.StdOut.Write(strOutput) 'write results to the command line
WScript.Echo(strOutput) 'write results to default output
You should read both streams INSIDE the loop as well as after it. When your process is verbose then it will block on the I/O buffer when this buffer will not be emptyfied succesively!!!
I think Tomek's answer is good, but incomplete.
Here's a code example.
Private Sub ExecuteCommand(sCommand$)
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
Dim oExec As Object, oOut As TextStream
'Exec the command
Set oExec = wsh.Exec(sCommand$)
Set oOut = oExec.StdOut
'Wait for the command to finish
While Not oOut.AtEndOfStream
Call Debug.Print(oOut.ReadLine)
Wend
Select Case oExec.Status
Case WshFinished
Case WshFailed
Err.Raise 1004, "EndesaSemanal.ExecuteCommand", "Error: " & oExec.StdErr.ReadAll()
End Select
End Sub

Open multiple .vbs one by one

i want .vbs script, to open multiple large files .vbs [i want to Open .vbs one by one] that do not make me, lag in PC.
0001.vbs, 0002.vbs, 0003.vbs, 0004.vbs
is can be different names like:
Anna.vbs, Diana.vbs, Antony.vbs, Andy.vbs
Example:
run C:\0001.vbs
MsgBox "0001.vbs IS END"
Next Open run C:\0002.vbs
MsgBox YES NO
MsgBox "0002.vbs IS END"
Next Open run C:\0003.vbs
MsgBox YES NO
MsgBox "0003.vbs IS END"
Next Open run C:\0004.vbs
MsgBox YES NO
MsgBox "0004.vbs IS END"
Thank you for you help.
Set Shell = CreateObject("WScript.Shell")
For i = 1 To 4
strFile = Right("0000" & i, 4) & ".vbs"
If MsgBox("Would you like to run " & strFile & "?", vbYesNo Or vbQuestion) = vbYes Then
Shell.Run "c:\" & strFile, 1, True
MsgBox strFile & " IS END"
End If
Next
Just make sure you pass True as the last parameter to Shell.Run so that this script waits until the others are done before reporting that they've ended.
Edit: To answer your comment about using names, you can loop through an array created on-the-fly.
For Each strName In Array("Anna", "Diana", "Antony", "Andy")
Next
To not make you wait for each sub process/.vbs before you start the next, don't use the 3rd/wait/true parameter to the .Run method:
a.vbs
Option Explicit
Dim oWSH : Set oWSH = CreateObject("WScript.Shell")
Dim v
For v = 0 To 1
oWSH.Run "cscript.exe " & v & ".vbs", 0, False
Next
MsgBox WScript.ScriptName & " done. " & Now()
0.vbs, 1.vbs
Option Explicit
Randomize
WScript.Sleep Rnd() * 1000
MsgBox WScript.ScriptName & " done. " & Now()
Evidence:
As you can see, a.vbs is finished first and 0.vbs and 1.vbs terminate in random/not in call order.
We have
0001.vbs, 0002.vbs, 0003.vbs, 0004.vbs
Assuming that you have this script file with the after mentioned files in the same directory.
If not, just modify the full path of your vbs files you want to run.
Instead of
WshShell.Run ".\0001.vbs"
You use for example:
WshShell.Run "c:\indel\0001.vbs"
This is the script:
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run ".\0001.vbs"
WshShell.Run ".\0002.vbs"
WshShell.Run ".\0003.vbs"
WshShell.Run ".\0004.vbs"
What you need to do is make this code
do
msgbox("haha you cant close this")
CreateObject ("WScript.Shell").Run(".\Duplicate.vbs")
loop

Resources