VBS Run cmd.exe output to a variable; not text file - vbscript

This is what I have so far. It works; outputing the folder path to temp to a text file.
What I really want, is to output the data to a variable. Every example I see online, show how to do this using something like:
set objScriptExec = wshShell.Exec (strCommand)
followed by
strresult = LCase(objScriptExec.StdOut.ReadAll. // code
I want this to run with Run, not Exec, because I want the command prompt windows to be hidden as I will performing many commands with the code below. How can I capture that output to a variable?
Set wsShell = CreateObject("WScript.Shell")
strCommand = "cmd /c echo %temp% > %temp%\test.txt"
wsShell.Run strcommand,0,True

This may be done with the Windows Script Host Exec command. StdOut, StdIn, and StdErr may all be accessed, and ERRORLEVEL is available when the command completes.
Dim strMessage, strScript, strStdErr, strStdOut
Dim oExec, oWshShell, intErrorLevel
Dim ComSpec
Set oWshShell = CreateObject("WScript.Shell")
ComSpec = oWshShell.ExpandEnvironmentStrings("%comspec%")
intErrorLevel = 0
strScript = ComSpec & " /C echo %temp%"
On Error Resume Next
Set oExec = oWshShell.Exec (strScript)
If (Err.Number <> 0) Then
strMessage = "Error: " & Err.Message
intErrorLevel = 1
Else
Do While oExec.Status = 0
Do While Not oExec.StdOut.AtEndOfStream
strStdOut = strStdOut & oExec.StdOut.ReadLine & vbCrLf
Loop
Do While Not oExec.StdErr.AtEndOfStream
strStdErr = strStdErr & oExec.StdErr.ReadLine & vbCrLf
Loop
WScript.Sleep 0
Loop
intErrorLevel = oExec.ExitCode
strMessage = strStdOut & strStdErr & CStr(intErrorLevel)
End If
WScript.Echo (strMessage)
NOTE: Replacing "ReadLine" above with "Read(1)" accomplishes the same thing, but adds an ability to process characters rather than whole lines.

Of course Wscript.Shell would be a lot easier, but, since you want more fine grain control of your session, consider using Win32_Process. Usually, one uses this to control the placement of a new window, but, in your case, you want it hidden, so I set startupInfo.ShowWindow = 0 which means SW_HIDE. The following declares a VBScript function called RunCmd and which will run a command in an invisible window saving the output to a text file and then return the contents of the text file to the caller. As an example, I invoke RunCmd with the HOSTNAME command:
Function RunCmd(strCmd)
Dim wmiService
Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
Dim startupInfo
Set startupInfo = wmiService.Get("Win32_ProcessStartup")
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim cwd
cwd = fso.GetAbsolutePathname(".")
startupInfo.SpawnInstance_
startupInfo.ShowWindow = 0
' startupInfo.X = 50
' startupInfo.y = 50
' startupInfo.XSize = 150
' startupInfo.YSize = 50
' startupInfo.Title = "Hello"
' startupInfo.XCountChars = 36
' startupInfo.YCountChars = 1
Dim objNewProcess
Set objNewProcess = wmiService.Get("Win32_Process")
Dim intPID
Dim errRtn
errRtn = objNewProcess.Create("cmd.exe /c """ & strCmd & """ > out.txt", cwd, startupInfo, intPID)
Dim f
Set f = fso.OpenTextFile("out.txt", 1)
RunCmd = f.ReadAll
f.Close
End Function
MsgBox RunCmd("HOSTNAME")
References:
Create method of the Win32_Process class
Win32_ProcessStartup class

Related

Trying to create a grads script and getting error " Expected end of statement " how can I solve it?

This is a screenshot of what I'm getting the error:
The file name of the script it's coming with the grads program.
gradsgui.vbs
The content of the file the script:
' Lightweight script to call actual executables down bellow. Eventually it
' could include the same functionality of the Perl version. Now it seats in
' the very top, above Contents/
Dim objFileSystem, objFILE
' Find out where we actually are
' ------------------------------
ScriptPath = Left(WScript.ScriptFullName, _
Len(WScript.ScriptFullName) - Len(WScript.ScriptName))
' Get the current version from file
' ---------------------------------
Set objFileSystem = CreateObject("Scripting.fileSystemObject")
Set objFILE = objFileSystem.OpenTextFile(ScriptPath & "Contents\Cygwin\Versions\Current#", 1)
Versions = Split(objFILE.ReadAll, vbCrLf)
Version = Left(Versions(0),Len(Versions(0))-1)
objFile.Close
Set objFileSystem = Nothing
' Actual executable path
' ----------------------
ActualPath = ScriptPath & "Contents\Cygwin\Versions\" & Version & "\i686\"
ExecutableName = Left(WScript.ScriptName,Len(WScript.ScriptName)-4) & ".exe"
ExecutableFullName = ActualPath & ExecutableName
' WScript.echo "Running <" & ExecutableFullName & ">"
' Command line arguments
' ----------------------
Set ArgObj = WScript.Arguments
sArgCount = ArgObj.Count
args = " "
For x = 0 To sArgCount - 1
args = args & " " & ArgObj(x)
Next
Set ArgObj = Nothing
Set xsize = 650 500
'Start actual application down below
'-----------------------------------
Set objShell = CreateObject("WScript.Shell")
'objShell.Run "%COMSPEC% /k" & ExecutableFullName & args
objShell.Run ExecutableFullName & args
Set objShell = Nothing
The line that I added that give the error is:
set xsize = 650 500
If I type this command in the console window when running the grads.exe it will work fine. But using the script it's giving me this error.
What i did is adding to the end of the file script two lines:
'Start actual application down below
'-----------------------------------
Set objShell = CreateObject("WScript.Shell")
Set env = objShell.Environment("PROCESS")
env("xsize") = "650 500"
' objShell.Run "%COMSPEC% /k" & ExecutableFullName & args
objShell.Run ExecutableFullName & args
Set objShell = Nothing
The lines i added are:
Set env = objShell.Environment("PROCESS")
env("xsize") = "650 500"
But they are not doing anything. It's not opening the new window in this size.
Looks like you're mixing VBScript and CMD commands here. You probably mean to set xsize=650 500 as an environment variable, but in VBScript the Set keyword is used for assigning objects to variables, not for defining variables in general like in CMD.
Try defining the variable in the process environment, so that it's inherited by the child process you're starting:
Set objShell = CreateObject("WScript.Shell")
Set env = objShell.Environment("PROCESS")
env("xsize") = "650 500"
objShell.Run ExecutableFullName & args

How to run windows executable and delete files from sub folders

I need a quick script do two parts.
Run a windows executable
Delete files within a folder and subfolders (*.jpg, *.img).
The first part of the below script works (running the executable) but I am getting stuck on part 2. I get
Cannot use parentheses when calling a sub
The error is on the line with the RecursiveDelete call. I actually cut and pasted that code from another SO question. I have googled the error but still don't understand.
Can anybody know how to get this script working?
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & "C:\Users\acer\Desktop\CT\process.exe" & Chr(34), 0
Set WshShell = Nothing
Dim PicArray(2)
Dim p
PicArray(1) = "*.jpg"
PicArray(2) = "*.img"
For p = 1 To 2
RecursiveDelete ("D:\pictures", PicArray(p))
Next p
Private Sub RecursiveDelete(ByVal Path As String, ByVal Filter As String)
Dim s
For Each s In System.IO.Directory.GetDirectories(Path)
try
RecursiveDelete(s, Filter)
catch dirEx as exception
debug.writeline("Cannot Access " & s & " : " & dirEx.message
end try
Next
For Each s In System.IO.Directory.GetFiles(Path, Filter)
try
System.IO.File.Delete(s)
catch ex as exception
debug.writeline("Cannot delete " & s & " : " & ex.message)
end try
Next
End Sub
Update: Revised answer from Hackoo that works great.
Option Explicit
Dim fso,RootFolder, wshShell
set fso = CreateObject("Scripting.FileSystemObject")
RootFolder = "D:\pictures"
Set RootFolder = fso.GetFolder(RootFolder)
Call RecursiveDelete(RootFolder)
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & "C:\process.exe" & Chr(34), 0
Set WshShell = Nothing
'*****************************************************************************
Function RecursiveDelete(Folder)
Dim File,MyFile,Ext,i,SubFolder
Set Folder = fso.GetFolder(Folder)
For each File in Folder.Files
Set MyFile = fso.GetFile(File)
Ext = Array("iMG","JPG")
For i = LBound(Ext) To UBound(Ext)
If LCase(fso.GetExtensionName(File.name)) = LCase(Ext(i)) Then
MyFile.Delete()
Exit For
end if
Next
Next
For each SubFolder in Folder.SubFolders
Call RecursiveDelete(SubFolder)
Next
End Function
'*****************************************************************************
Try like this way :
Option Explicit
Dim fso,RootFolder
set fso = CreateObject("Scripting.FileSystemObject")
RootFolder = "D:\pictures"
Set RootFolder = fso.GetFolder(RootFolder)
Call RecursiveDelete(RootFolder)
Msgbox "Pictures Cleaned !",vbInformation,"Pictures Cleaned !"
'*****************************************************************************
Function RecursiveDelete(Folder)
Dim File,MyFile,Ext,i,SubFolder
Set Folder = fso.GetFolder(Folder)
For each File in Folder.Files
Set MyFile = fso.GetFile(File)
Ext = Array("jpg","img")
For i = LBound(Ext) To UBound(Ext)
If LCase(fso.GetExtensionName(File.name)) = LCase(Ext(i)) Then
MyFile.Delete()
Exit For
end if
Next
Next
For each SubFolder in Folder.SubFolders
Call RecursiveDelete(SubFolder)
Next
End Function
'*****************************************************************************
Instead of passing the array item into RecursiveDelete, obtain the contents of the array item into a variable within the loop, and pass that variable instead.
Code would be similar to this- did not have a chance to test syntax.
For p = 1 To 2
Dim PicItem
PicItem = PicArray(p)
RecursiveDelete ("D:\pictures", PicItem )
Next p

How to run a file on background using vbscript with launch options

I need to run a batch file in the background with launch option "1" (so it will %1 in the batch file).
here is my code:
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & "C:\Program Files\Pineapplesoft\Lost computer\lostcomputeraudio.bat" & Chr(34), 0
Set WshShell = Nothing
Use a function to quote strings, and - optionally - a sub to map all elements of an array via a manipulator function to build command lines in a structured/well scaling way; use Join() to put the parts together (with automagical space separator):
Option Explicit
Function qq(s) : qq = """" & s & """" : End Function
Sub mapF(a, f)
Dim i
For i = LBound(a) To UBound(a)
a(i) = f(a(i))
Next
End Sub
Dim sFSpec : sFSpec = "C:\Program Files\Pineapplesoft\Lost computer\lostcomputeraudio.bat"
Dim aParms : aParms = Split("1#/pi:pa po#last parm", "#")
mapF aParms, GetRef("qq")
Dim sCmd : sCmd = Join(Array( _
qq(sFSpec) _
, Join(aParms) _
))
WScript.Echo qq(sCmd)
output:
cscript startaudio.vbs
""C:\Program Files\Pineapplesoft\Lost computer\lostcomputeraudio.bat" "1" "/pi:pap po" "last parm""
The script you ask is as follows:
Set objArgs = Wscript.Arguments
Set WshShell = WScript.CreateObject("WScript.Shell")
Return = WshShell.Run("C:\Program Files\Pineapplesoft\Lost computer\lostcomputeraudio.bat " & objArgs(0), 0, false)
Save it for example as myscript.vbs.
Note that the parameter 0 in the code means that the window will be hidden. The paremeter false in the code means that the excution of the .vbs will not wait for the .bat to finish.
What will happen is that, the .vbs will start the .bat and finish its execution, leaving the .bat being executed in the background, as you request.
Exeucute it like this:
c:\<whatever>\wscript myscript.vbs <the_parameter>

VbScript to trim trailing pipes off file at 35 pipes

So I was initially writing this in batch, but the number of tokens usable with ASCII were too small, i guess it only allows 26, and I need 35 pipes to remain in my output file.
I am new to VBScript, but basically I want it to read in the original file, do some magic to select the first character in the file to the last 35 pipes (and everything between, even in the space between the two pipes is blank). Then output that file to another file, while retaining the integrity of original.
Here is my code so far:
' **************
' ** Anthony B.
' **************
' ** PipeDropper
' **************
Dim WshShell, oExec
Set wshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInputFile = objFSO.OpenTextFile("C:\Users\aborgetti\Desktop\Pipe Delimiter Project\oauthrn.cms",1)
Set objOutputFile = objFSO.OpenTextFile("C:\Users\aborgetti\Desktop\Pipe Delimiter Project\output.txt",8,True)
Do until objInputFile.AtEndofStream
strcomputer = objInputFile.ReadLine
strCommand = "dsquery computer -name " & strComputer
Set oExec = WShShell.Exec(strCommand)
If (oExec.Status = 0) Then
If (oExec.stdOut.ReadAll = "") Then
objOutputFile.WriteLine(strComputer)
End If
End If
Loop
objInputFile.Close
objOutputFile.Close
Issues
This line Set oExec = WShShell.Exec(strCommand)
says it can't find the file that's specified...so I'm not sure why that's bad.
And then where do I go from here?
Thanks in advance!
UPDATE
Here is a line that would be in the file, usually anywhere from 10-100 times...
RE|922124607|1 |KimV|HOS99999|Y|N|2014-04-02 15:49:14|2014-04-02 15:49:58|Y|2014-04-02 00:00:00|R9815|01|1 |2014-04-02 00:00:00|493.90||||2016-04-02|N||HOS99999|||06|PROV99999|2014-04-02 15:48:20|2014-04-02||R9815|2014-04-02 00:00:00|2016-04-02 00:00:00||||||98960|06 |08|6|6|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||02|||||||Z4|2014-04-02 15:49:58|04|001|01|***|PMER|***|***|2013-08-01||||||||||||||||||||||||||||||||||||||||
Everything after the last 01 needs to go...so:
|***|PMER|***|***|2013-08-01||||||||||||||||||||||||||||||||||||||||
Should be:
Start of line ... |***|PMER|***|***|2013-08-01
I doubt that your problem
has anything to do with pipes
the code you published is the code that caused the error
There are two ways to get an error 424 "Object required" for a statement like
Set a = b.c(d)
The first (and obvious): b isn't an object. The second: the return value of b.c(d) isn't an object.
Your code condensed:
Set wshShell = CreateObject("WScript.Shell")
strCommand = "hostname"
Set oExec = WShShell.Exec(strCommand)
WScript.Echo oExec.Stdout.Readline()
runs without a problem. A slight change:
Set wshShell = CreateObject("WScript.Shell")
strCommand = "hostname"
Set oExec = WShShel1.Exec(strCommand)
WScript.Echo oExec.Stdout.Readline()
fails with "Object required". Do you spot the typo? Why not let "Option Explicit" help you:
Option Explicit
Dim wshShell : Set wshShell = CreateObject("WScript.Shell")
Dim strCommand : strCommand = "hostname"
Dim oExec : Set oExec = WShShel1.Exec(strCommand)
WScript.Echo oExec.Stdout.Readline()
output:
...\22871772.vbs(4, 18) Microsoft VBScript runtime error: Variable is undefined: 'WShShel1'
If you made sure that no typo caused the problem, you'll have to check whether the variable is changed/assigned to between initialization and use:
Option Explicit
Dim wshShell : Set wshShell = CreateObject("WScript.Shell")
Dim strCommand : strCommand = "hostname"
'...
wShSheLL = "oops"
'...
Dim oExec : Set oExec = WShShell.Exec(strCommand)
WScript.Echo oExec.Stdout.Readline()
again fails with error 424.
Update wrt the pipes:
I'd choose Split() (with count set to #pipes you want + 1) to deal with the trailing pipes:
>> n = 8 + 1
>> s = "|abc123|1*|004|**gobbligook|001|%|2014-01-01|||||||||||||"
>> a = Split(s, "|", n) ' <-- 9th elm get all the junk
>> WScript.Echo UBound(a)
>> a(n - 1) = "" ' <-- zap the junk
>> WScript.Echo Join(a, "|")
>>
8
|abc123|1*|004|**gobbligook|001|%|2014-01-01|
To delete a tail of |'s, a RegExp seems more appropriate:
>> set r = New RegExp
>> r.Pattern = "\|+$"
>> WScript.Echo r.Replace(s, "")
>>
|abc123|1*|004|**gobbligook|001|%|2014-01-01

VBscript code to capture stdout, without showing console window

This is a VBScript code example that shows how to catch whatever a command line program sends to standard output.
It executes the command xcopy /? and shows the output in a message box. Before the message box appears, for a split second you see the console window popping up.
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExec = objShell.Exec("xcopy /?")
Do
line = objExec.StdOut.ReadLine()
s = s & line & vbcrlf
Loop While Not objExec.Stdout.atEndOfStream
WScript.Echo s
Here is an other VBScript code example that shows how to execute a script without showing the console window.
objShell.Run "c:\temp\mybatch.bat C:\WINDOWS\system32\cmd.exe", 0
or
objShell.Run "c:\temp\myscript.vbs C:\WINDOWS\system32\cscript.exe", 0
As you can see it has the form <script><space><executor>.
The last example uses objShell.Run instead of objShell.Exec
What I don't know is how to execute a command line program (if necessary from a batch file), catch the standard output, without showing the console window. Any ideas?
I usually use this:
Wscript.echo execStdOut("ping google.com")
Function execStdOut(cmd)
Dim goWSH : Set goWSH = CreateObject( "WScript.Shell" )
Dim aRet: Set aRet = goWSH.exec(cmd)
execStdOut = aRet.StdOut.ReadAll()
End Function
For more advanced commands youc an wrap to comspec (cmd)
my res = execStdOut("%comspec%" & " /c " & """" & "dir /b c:\windows\*.exe" & """" & " && Echo. && Echo finished")
In order to redirect the output to the console, run the script using cscript, ex.: c:\cscript myscript.vbs.
cscript has a few command line options. The most important (to me) is the switch //NOLOGO. If yoy use it (cscript //nologo myscript.vbs) it will omit Microsoft merchandise...
This proof of concept script:
' pocBTicks.vbs - poor man's version of backticks (POC)
Option Explicit
' Globals
Const SW_SHOWMINNOACTIVE = 7
Const ForReading = 1
Dim goFS : Set goFS = CreateObject( "Scripting.FileSystemObject" )
Dim goWSH : Set goWSH = CreateObject( "WScript.Shell" )
' Dispatch
WScript.Quit demoBTicks()
' demoBTicks -
Function demoBTicks()
demoBTicks = 1
Dim aCmds : aCmds = Array( _
"dir pocBTicks.vbs" _
, "dur pocBTicks.vbs" _
, "xcopy /?" _
)
Dim sCmd
For Each sCmd In aCmds
WScript.Echo "########", sCmd
Dim aRet : aRet = BTicks( sCmd )
Dim nIdx
For nIdx = 0 To UBound( aRet )
WScript.Echo "--------", nIdx
WScript.Echo aRet( nIdx )
Next
Next
demoBTicks = 0
End Function ' demoBTicks
' BTicks - execute sCmd via WSH.Run
' aRet( 0 ) : goWSH.Run() result
' aRet( 1 ) : StdErr / error message
' aRet( 2 ) : StdOut
' aRet( 3 ) : command to run
Function BTicks( sCmd )
Dim aRet : aRet = Array( -1, "", "", "" )
Dim sFSpec2 : sFSpec2 = goFS.GetAbsolutePathName( "." )
Dim sFSpec1 : sFSpec1 = goFS.BuildPath( sFSpec2, goFS.GetTempName() )
sFSpec2 = goFS.BuildPath( sFSpec2, goFS.GetTempName() )
aRet( 3 ) = """%COMSPEC%"" /c """ + sCmd + " 1>""" + sFSpec1 + """ 2>""" + sFSpec2 + """"""
Dim aErr
On Error Resume Next
aRet( 0 ) = goWSH.Run( aRet( 3 ), SW_SHOWMINNOACTIVE, True )
aErr = Array( Err.Number, Err.Description, Err.Source )
On Error GoTo 0
If 0 <> aErr( 0 ) Then
aRet( 0 ) = aErr( 0 )
aRet( 1 ) = Join( Array( aErr( 1 ), aErr( 2 ), "(BTicks)" ), vbCrLf )
BTicks = aRet
Exit Function
End If
Dim nIdx : nIdx = 1
Dim sFSpec
For Each sFSpec In Array( sFSpec2, sFSpec1 )
If goFS.FileExists( sFSpec ) Then
Dim oFile : Set oFile = goFS.GetFile( sFSpec )
If 0 < oFile.Size Then
aRet( nIdx ) = oFile.OpenAsTextStream( ForReading ).ReadAll()
goFS.DeleteFile sFSpec
End If
End If
nIdx = nIdx + 1
Next
BTicks = aRet
End Function
shows how to use .Run and temporary files to get something like backticks with a hidden console. Decent file handling, quoting in sCmd, cleaning of the returned strings, and dealing with encodings will require more work. But perhaps you can use the strategy to implement something that fits your needs.
If you don't mind having the taskbar button appear, you can just move the console window offscreen before launching it.
If the HKCU\Console\WindowPosition key exists, Windows will use its value to position the console window. If the key doesn't exist, you'll get a system-positioned window.
So, save the original value of this key, set your own value to position it offscreen, call Exec() and capture its output, then restore the key's original value.
The WindowPosition key expects a 32-bit value. The high word is the X coordinate and the low word is the Y coordinate (XXXXYYYY).
With CreateObject("WScript.Shell")
' Save the original window position. If system-positioned, this key will not exist.
On Error Resume Next
intWindowPos = .RegRead("HKCU\Console\WindowPosition")
On Error GoTo 0
' Set Y coordinate to something crazy...
.RegWrite "HKCU\Console\WindowPosition", &H1000, "REG_DWORD"
' Run Exec() and capture output (already demonstrated by others)...
.Exec(...)
' Restore window position, if previously set. Otherwise, remove key...
If Len(intWindowPos) > 0 Then
.RegWrite "HKCU\Console\WindowPosition", intWindowPos, "REG_DWORD"
Else
.RegDelete "HKCU\Console\WindowPosition"
End If
End With
If you really want to make sure the coordinates are offscreen, you can get the screen dimensions via VBScript by using IE or other tools.
To return in VBA all subfolders in G:\OF
sub M_snb()
c00= createobejct("wscript.Shell").exec("cmd /c Dir G:\OF\*. /s/b").stdout.readall
end sub
to split the returned string into an array
sub M_snb()
sn=split(createobejct("wscript.Shell").exec("cmd /c Dir G:\OF\*. /s/b").stdout.readall,vbCrLf)
for j=0 to ubound(sn)
msgbox sn(j)
next
End Sub
This is the way you can get the command line StdOut (result) without see this popup black dos windows in vbscript:
Set Sh = CreateObject("WScript.Shell")
tFile=Sh.ExpandEnvironmentStrings("%Temp%")&"\t.txt"
Sh.Run "cmd.exe /c xcopy /? > """&tFile&""" ",0,False
Wscript.echo CreateObject("Scripting.FileSystemObject").openTextFile(tFile).readAll()
Instead of WScript.Shell, consider using using Win32_Process with startupInfo.ShowWindow = 0 to launch the process with SW_HIDE. I posted a detailed example under VBS Run cmd.exe output to a variable; not text file.

Resources