Emulate Run Command? - vbscript

I'm attempting to create a basic Run command emulator using VBScript, or .bat if that would be easier.
I have had no formal education on these languages, but can do very basic functions from looking at forums and web help. I need this code to be able to request user input for the program they want to open (input box function) and actually open the program.
The server I work at has both Run and CMD blocked, but not written scripts.
Any help would be appreciated.
~Jester

This runs CMD and captures it's output.
Set Inp = WScript.Stdin
Set Outp = Wscript.Stdout
Set cmd = CreateObject("Wscript.Shell").Exec("cmd")
cmd.stdin.writeline "dir"
wscript.sleep 20000
cmd.stdin.writeline "dir"
cmd.stdin.writeline "exit"
Do While Not cmd.stdout.AtEndOfStream
results = cmd.stdout.readall
If err.number <> 0 then Exit Do
wscript.echo results
Loop
'wscript.sleep 5000
This shows making your own console program. Most menu options don't do anything.
Set Arg = WScript.Arguments
set WshShell = createObject("Wscript.Shell")
Set Inp = WScript.Stdin
Set Outp = Wscript.Stdout
Showmenu
Sub ShowHelpMenu
outp.writeline " -----------------------------------------------------------------------------"
outp.writeblanklines(1)
outp.writeline " Menu"
outp.writeline " ----"
outp.writeblanklines(1)
outp.writeline " 1 Help 2 HTML Help 3 Version 4 History"
outp.writeblanklines(1)
outp.writeline " 5 Exit"
outp.writeblanklines(1)
outp.write "Filter>"
End Sub
'=============================================
Sub ShowMenu
Do
ShowHelpMenu
Answ=Inp.read(1)
Outp.write Answ
' Answ=Inp.readline
If Answ = "1" Then
ShowGeneralHelp "TEXT"
Elseif Answ = "2" Then
ShowGeneralHelp "HTML"
Elseif Answ = "3" Then
Version
Elseif Answ = "4" Then
History
Elseif Answ = "5" Then
Exit Do
End If
Loop
End Sub
'=============================================
Sub History
On Error Resume Next
WshShell.Run """" & FilterPath & "FilterHistory.txt""" , 1, False
err.clear
End Sub
'=============================================
Sub Version
outp.writeblanklines(1)
outp.writeline " Version"
outp.writeline " -------"
outp.writeblanklines(1)
outp.writeline " Filter Ver 0.6 - 2015 (Public Domain)"
outp.writeblanklines(1)
outp.writeline " by David Candy"
outp.writeblanklines(1)
End Sub
This shows a basic batch.
:start
set /p CMDToExec=Enter Command
%CMDToExec%
Goto Start

Related

How to apply a VBA macro to all files in a directory?

I have a sub-directory with ~1000 Word Documents I'd like to apply the following macro to style hyperlinks to each of them, but I can't really open each of them to run the script. Is there any way I can set it to apply to every document in the directory? Could I call it from a bash script?
Sub FormatLinks()
Dim H As Hyperlink
For Each H In ActiveDocument.Hyperlinks
H.Range.Select ' (A)
Selection.ClearFormatting ' (B)
H.Range.Style = ActiveDocument.Styles("Hyperlink") ' (C)
Next H
End Sub
This is from Filter, a program that filters stdin to stdout. This part here is from run a command line specifed script on each line in a file. Dir /b gives you a list of files.
Set Arg = WScript.Arguments
set WshShell = createObject("Wscript.Shell")
Set Inp = WScript.Stdin
Set Outp = Wscript.Stdout
RawScript = Arg(1)
'Remove ^ from quoting command line and replace : with vbcrlf so get line number if error
Script = Replace(RawScript, "^", "")
Script = Replace(Script, "'", chr(34))
Script = Replace(Script, ":", vbcrlf)
'Building the script with predefined statements and the user's code
Script = "Dim gU" & vbcrlf & "Dim gdU" & vbcrlf & "Set gdU = CreateObject(" & chr(34) & "Scripting.Dictionary" & chr(34) & ")" & vbcrlf & "Function UF(L, LC)" & vbcrlf & "Set greU = New RegExp" & vbcrlf & "On Error Resume Next" & vbcrlf & Script & vbcrlf & "End Function" & vbcrlf
'Testing the script for syntax errors
On Error Resume Next
set ScriptControl1 = wscript.createObject("MSScriptControl.ScriptControl",SC)
With ScriptControl1
.Language = "VBScript"
.UseSafeSubset = False
.AllowUI = True
.AddCode Script
End With
With ScriptControl1.Error
If .number <> 0 then
Outp.WriteBlankLines(1)
Outp.WriteLine "User function syntax error"
Outp.WriteLine "=========================="
Outp.WriteBlankLines(1)
Outp.Write NumberScript(Script)
Outp.WriteBlankLines(2)
Outp.WriteLine "Error " & .number & " " & .description
Outp.WriteLine "Line " & .line & " " & "Col " & .column
Exit Sub
End If
End With
ExecuteGlobal(Script)
'Remove the first line as the parameters are the first line
'Line=Inp.readline
Do Until Inp.AtEndOfStream
Line=Inp.readline
LineCount = Inp.Line
temp = UF(Line, LineCount)
If err.number <> 0 then
outp.writeline ""
outp.writeline ""
outp.writeline "User function runtime error"
outp.writeline "==========================="
Outp.WriteBlankLines(1)
Outp.Write NumberScript(Script)
Outp.WriteBlankLines(2)
Outp.WriteLine "Error " & err.number & " " & err.description
Outp.WriteLine "Source " & err.source
Outp.WriteLine "Line number and column not available for runtime errors"
wscript.quit
End If
outp.writeline temp
Loop
General Use
filter <inputfile >outputfile
filter <inputfile | other_command
other_command | filter >outputfile
other_command | filter | other_command
Vbs
filter vbs "text of a vbs script"
filter vb "text of a vbs script"
Use colons to seperate statements and lines. Use single quotes in place of double quotes, if you need a single quote use chr(39). Escape brackets and ampersand with the ^ character. If you need a caret use chr(136).
The function is called UF (for UserFunction). It has two parameters, L which contains the current line and LC which contains the linecount. Set the results of the script to UF. See example.
There are three global objects available. An undeclared global variable gU to maintain state. Use it as an array if you need more than one variable. A Dictionary object gdU for saving and accessing previous lines. And a RegExp object greU ready for use.
Example
This vbs script inserts the line number and sets the line to the function UF which Filter prints.
filter vbs "uf=LC ^& ' ' ^& L"<"%systemroot%\win.ini"
This is how it looks in memory
Dim gU
Set gdU = CreateObject("Scripting.Dictionary")
Set greU = New RegExp
Function UF(L, LC)
---from command line---
uf=LC & " " & L
---end from command line---
End Function
If there is a syntax error Filter will display debugging details.
User function syntax error
1 Dim gU
2 Dim gdU
3 Set greU = CreateObject("Scripting.Dictionary")
4 Function UF(L, LC)
5 On Error Resume Next
6 uf=LC dim & " " & L
7 End Function
Error 1025 Expected end of statement
Line 6 Col 6
User function runtime error
1 Dim gU
2 Dim gdU
3 Set greU = CreateObject("Scripting.Dictionary")
4 Function UF(L, LC)
5 On Error Resume Next
6 uf=LC/0 & " " & L
7 End Function
Error 11 Division by zero
Source Microsoft VBScript runtime error
Line number and column not available for runtime errors
Other examples
Reverse each line
filter vbs "uf=StrReverse^(L^)"<"%systemroot%\win.ini"

How can we programmatically know the syntax error using msscript.ocx?

I have implemented msscript.ocx using c# and it works for VBScript.
Consider the following VBScript code:
For i = 0 To 5
'The following line has missing 'Then'. It should show an error.
If i = 2
Exit For
End If
Next
How can we tell if there is an error in line containing If (missing Then) without running the script?
You get the error when loading.
Set Arg = WScript.Arguments
set WshShell = createObject("Wscript.Shell")
Set Inp = WScript.Stdin
Set Outp = Wscript.Stdout
Sub VBSCmd
RawScript = Arg(1)
'Remove ^ from quoting command line and replace : with vbcrlf so get line number if error
Script = Replace(RawScript, "^", "")
Script = Replace(Script, "'", chr(34))
Script = Replace(Script, ":", vbcrlf)
'Building the script with predefined statements and the user's code
Script = "Dim gU" & vbcrlf & "Dim gdU" & vbcrlf & "Set gdU = CreateObject(" & chr(34) & "Scripting.Dictionary" & chr(34) & ")" & vbcrlf & "Function UF(L, LC)" & vbcrlf & "Set greU = New RegExp" & vbcrlf & "On Error Resume Next" & vbcrlf & Script & vbcrlf & "End Function" & vbcrlf
'Testing the script for syntax errors
On Error Resume Next
set ScriptControl1 = wscript.createObject("MSScriptControl.ScriptControl",SC)
With ScriptControl1
.Language = "VBScript"
.UseSafeSubset = False
.AllowUI = True
.AddCode Script
End With
With ScriptControl1.Error
If .number <> 0 then
Outp.WriteBlankLines(1)
Outp.WriteLine "User function syntax error"
Outp.WriteLine "=========================="
Outp.WriteBlankLines(1)
Outp.Write NumberScript(Script)
Outp.WriteBlankLines(2)
Outp.WriteLine "Error " & .number & " " & .description
Outp.WriteLine "Line " & .line & " " & "Col " & .column
Exit Sub
End If
End With
ExecuteGlobal(Script)
'Remove the first line as the parameters are the first line
'Line=Inp.readline
Do Until Inp.AtEndOfStream
Line=Inp.readline
LineCount = Inp.Line
temp = UF(Line, LineCount)
If err.number <> 0 then
outp.writeline ""
outp.writeline ""
outp.writeline "User function runtime error"
outp.writeline "==========================="
Outp.WriteBlankLines(1)
Outp.Write NumberScript(Script)
Outp.WriteBlankLines(2)
Outp.WriteLine "Error " & err.number & " " & err.description
Outp.WriteLine "Source " & err.source
Outp.WriteLine "Line number and column not available for runtime errors"
wscript.quit
End If
outp.writeline temp
Loop
End Sub
Vbs
filter vbs "text of a vbs script"
Use colons to seperate statements and lines. Use single quotes in place of double quotes, if you need a single quote use chr(39). Escape brackets and ampersand with the ^ character. If you need a caret use chr(136).
The function is called UF (for UserFunction). It has two parameters, L which contains the current line and LC which contains the linecount. Set the results of the script to UF. See example.
There are three global objects available. An undeclared global variable gU to maintain state. Use it as an array if you need more than one variable. A Dictionary object gdU for saving and accessing previous lines. And a RegExp object greU ready for use.
Example
This vbs script inserts the line number and sets the line to the function UF which Filter prints.
filter vbs "uf=LC ^& ' ' ^& L"<"%systemroot%\win.ini"
This is how it looks in memory
Dim gU
Set gdU = CreateObject("Scripting.Dictionary")
Set greU = New RegExp
Function UF(L, LC)
---from command line---
uf=LC & " " & L
---end from command line---
End Function
If there is a syntax error Filter will display debugging details.

VBScript Error code 800A0409, Unterminated string constant, on line 1

I'm getting Error code 800A0409, Unterminated string constant, on line 1, 54 with the code below.
Option Explicit
Dim ObjProgressMsg
Dim fso,objText,strVstup,strVystup,f,dtmVyt,dtmF,dDiff,fName,fExt,fShort,dtmAkt,tx,msgText
Dim strMessage,strWindowTitle,strTemp,wshShell,objTempMessage,strTempVBS
Set fso = CreateObject("Scripting.FileSystemObject")
Set objText = fso.GetFile("l:\bat\posledni.den")
strVstup = "l:\filefolder\"
strVystup = "l:\backup"
dtmVyt = objText.DateLastModified
msgText = "Some text about copying and renaming" & VbCrLf & "files, please wait..."
ProgressMsg msgText
For Each f In fso.GetFolder(strVstup).Files
dtmF = f.DateLastModified
dDiff = DateDiff("s", dtmF, dtmVyt)
If dDiff < 0 Then
ProgressMsg ""
WScript.Echo f
End If
Next
WScript.Echo "Some text about the task being finished."
Function ProgressMsg( strMessage )
' Written by Denis St-Pierre
' Displays a progress message box that the originating script can kill in both 2k and XP
' If StrMessage is blank, take down previous progress message box
' Using 4096 in Msgbox below makes the progress message float on top of things
' CAVEAT: You must have Dim ObjProgressMsg at the top of your script for this to work as described
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strTEMP = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
If strMessage = "" Then
' Disable Error Checking in case objProgressMsg doesn't exists yet
On Error Resume Next
' Kill ProgressMsg
objProgressMsg.Terminate( )
' Re-enable Error Checking
On Error Goto 0
Exit Function
End If
strTempVBS = strTEMP + "\" & "Message.vbs" 'Control File for reboot
' Create Message.vbs, True=overwrite
Set objTempMessage = fso.CreateTextFile( strTempVBS, True )
objTempMessage.WriteLine( "MsgBox""" & strMessage & """, 4096, """ & "a_sp_rano" & """" )
objTempMessage.Close
' Disable Error Checking in case objProgressMsg doesn't exists yet
On Error Resume Next
' Kills the Previous ProgressMsg
objProgressMsg.Terminate( )
' Re-enable Error Checking
On Error Goto 0
' Trigger objProgressMsg and keep an object on it
Set objProgressMsg = WshShell.Exec( "%windir%\system32\wscript.exe " & strTempVBS )
End Function
The script should show a msgbox while searching for files newer than last modified date of posledni.den file. Then once it finds a file it should close msgbox and echo the file it found.
It works just fine if I change this:
msgText = "Some text about copying and renaming" & VbCrLf & "files, please wait..."
to this:
msgText = "Some text about copying and renaming" & "files, please wait..."
Removal of VbCrLf seems to fix that error, just no line break is obviously happening. I can't figure out why it's behaving like that, what am I doing wrong. Every kind of insight on the problem would be much appreciated.
Thank you in advance. :)
The error occurs in the execution of the generated .vbs. What you do is:
>> msg1 = "A" & vbCrLf & "B"
>> code = "MsgBox """ & msg1 & """"
>> WScript.Echo code
>>
MsgBox "A
B"
>> Execute code
>>
Error Number: 1033
Error Description: Unterminated string constant
What you should do:
>> msg1 = """A"" & vbCrLf & ""B"""
>> WScript.Echo msg1
>>
"A" & vbCrLf & "B"
>> code = "MsgBox " & msg1 & ", 4096"
>> WScript.Echo code
>>
MsgBox "A" & vbCrLf & "B", 4096
>> Execute code
>>
>> <-- no news are good news; message displayed

VBSCRIPT: TRACERT and PING a WEBADDRESS and write to text file without command promot popup

I need to write a diagnostic utility in VBS which i will package in my windows application installer.
I want the utility to run silently when the user is installing the application.
I tried:
Set pingCXS = objShell.Run("tracert -h 9 webaddress", 0, True)
Set pingCXSOutput = pingCXS.StdOut
strpingCXSOutput = pingCXSOutput.ReadAll
but it returns only the error code not the whole ping information.
When i use run method it gives a command window pop up:
Any other method to traceRT the webaddress without windows popup?
Also using a batch file is not a good option for me, as i have to use some WMI queries in the utility, which will require admin rights in batch file...
Please help out
Try this code :
Option Explicit
Dim ws,fso,TmpLogFile,Logfile,MyCmd,Webaddress,Param
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
TmpLogFile = "TmpFile.txt"
LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "log"
If fso.FileExists(LogFile) Then fso.DeleteFile LogFile
webaddress = "www.stackoverflow.com"
Param = "-h 9"
MyCmd = "Tracert " & Param & " " & Webaddress & " >> "& TmpLogFile &_
" & cmd /U /C Type " & TmpLogFile & " > " & LogFile & " & Del " & TmpLogFile & ""
Call Run(MyCmd,0,True)
ws.run LogFile
'**********************************************************************************************
Function Run(StrCmd,Console,bWaitOnReturn)
Dim ws,MyCmd,Result
Set ws = CreateObject("wscript.Shell")
'A value of 0 to hide the MS-DOS console
If Console = 0 Then
MyCmd = "CMD /C " & StrCmd & ""
Result = ws.run(MyCmd,Console,bWaitOnReturn)
If Result = 0 Then
MsgBox "Success"
Else
MsgBox "An unknown error has occurred!",16,"An unknown error has occurred!"
End If
End If
'A value of 1 to show the MS-DOS console
If Console = 1 Then
MyCmd = "CMD /K " & StrCmd & ""
Result = ws.run(MyCmd,Console,bWaitOnReturn)
If Result = 0 Then
MsgBox "Success"
Else
MsgBox "An unknown error has occurred!",16,"An unknown error has occurred!"
End If
End If
Run = Result
End Function

How to pass more than one variable in .bat file using VBS

I have a vbs code like:
Message4 = "Please enter Check Out Path"
Title4 = "Check Out Path "
variable1 = InputBox(Message4, Title4,"", 4500, 4500)
Message5 = "Please enter SVN URL"
Title5 = "SVN URL "
variable2 = InputBox(Message5, Title5, "", 4500, 4500)
Folder\batchfile.bat"""
objWshell.Run "batxhfile.bat"
and also batch file named batchfile.bat
#echo off
Color 42
echo. [ SVN Updater ]
set Checkout_path=checkout path
set SVN=C:\Program Files\TortoiseSVN\bin
set svn_url=SVN path
echo. Updating %Checkout_path% to SVN...
"%SVN%\TortoiseProc.exe" /command:checkout /url:"%svn_url%" /path:"%Checkout_path%" /closeonend:2
echo. done.
echo.
echo. Operation complete.
Now i want to pass the value of variable1 and variable2 from vbs code to batch file in the place of checkout path and svn path i have tried lots of method but no success uptill plz help.
I agree why you wouldn't simply call 'TortoiseProc.exe' from a VBS, however you may have you reasons for calling via a batch script. Simply pass arguments into a batch from a VBS:
`Const ERR_SUCCESS = 0
Const BAT_SCRIPT = "<folder>\batchfile.bat"
Dim oWSH, sCmd, iRC, sVar1, sVar2
Set oWSH = WScipt.CreateObjects("WScript.Shell")
Do While sVar1 <> ""
sVar1 = InputBox("Please enter Check Out Path", "Check Out Path", 4500, 4500)
Loop
Do While sVar2 <> ""
sVar2 = InputBox("Please enter SVN URL", "SVN URL", 4500, 4500)
Loop
sCmd = "cmd.exe /c """ & BAT_SCRIPT & "" "" & sVar1 & "" "" & sVar2 & """"
WScript.Echo "COMMAND: sCmd"
On Error Resume Next
iRC = oWSH.Run(sCmd, 0, True)
If iRC <> ERR_SUCCESS And Err.Number <> ERR_SUCCESS Then
MsgBox "ERROR: [" & Err.Source & "] " & CStr(Err.Number) & " - " & Err.Description & vbCrLf & _
" '" & BAT_SCRIPT "' return code = '" & CStr(iRC) & "' from command:" & vbCrLf & _
" COMMAND: " & sCmd, vbOkOnly, "Batch Script Error"
End If
Err.Clear
Set oWSH = Nothing`
You're result batch script command should be called like the following:
cmd.exe /c "<folder>\batchfile.bat" "<var1>" "<var2>"
Ensure your batch script gathers arguments, removes string double quotes and validates correctly:
`set Checkout_path=%1
set Checkout_path=%Checkout_path:~1,-1%
set svn_url=%2
set svn_url=%svn_url:~1,-1%
if /i "%Checkout_path%" ne "" (
exit /b 99
)
if /i "%svn_url%" ne "" (
exit /b 99
)`
Hope this helps ;)

Resources