I have create VBscript to enumerate user in group
Function GetUserInGroup()
strComputer = "localhost"
Set colGroups = GetObject("WinNT://" & strComputer & "")
colGroups.Filter = Array("group")
For Each objGroup In colGroups
For Each objUser in objGroup.Members
If objUser.name = "yayantritaryana" Then
WScript.stdout.write objGroup.Name + " "
End If
Next
Next
End Function
WScript.stdout.write "Group=" + GetUserInGroup
But when i execute it, the output is'nt what i expected
The output I Wanted is like
Group=Administrator SQLAdmin Sysadmin
Can someone help me ?
A Function has a purpose (eg. delivering a string of space separated group names). For that you assign the desired result to the function's name (other languages use some kind of return statement):
Function GetUserInGroup()
GetUserInGroup = "pi pa po"
End Function
WScript.stdout.write "Group=" & GetUserInGroup()
output:
cscript 29053176.vbs
Group=pi pa po
A function shouldn't have side-effects (like your
WScript.stdout.write objGroup.Name + " "
which prints names to the console before you output "Group=" in the last line of your script). Instead concatenate the objGroup.Names.
The operator for string concatenation is &.
The (possibly empty) argument list of a function call must be enclosed by (); these param list () are illegal for Sub calls.
Some extra code as food for thought:
Function GetUserInGroup()
For Each s In Split("pi pa po")
GetUserInGroup = GetUserInGroup & s & "*"
' GetUserInGroup = GetUserInGroup() & s & "*"
Next
End Function
WScript.stdout.write "Group=" & GetUserInGroup()
Related
Is there a way to write anonymous functions, pass them to other functions, in which they are invoked, in vbscript?
There are no anonymous functions/subs/methods in VBScript.
You can use GetRef() (see sample1, sample2) to get something like a function pointer that can be passed to functions/subs to be invoked there (callback). But there are no closures in VBScript, so tricks possible in other languages fail in VBScript.
For specific problems that can be solved with higher order functions in functional languages there may be (nearly) equivalent VBScript solutions involving classes/objects; but for discussing that approach you need to describe your/such a problem in detail.
VBScript has the ability to execute arbitatry code.
Execute and Eval just do what they say to a string containing code.
ExecuteGlobal adds code to your program, like a new function, new variables.
Script Control adds vbscript/jscript scripting language to any program including vbscripts. It can have access to the host's data.
If using ExecuteGlobal/Execute/Eval it is best to run through a scriptcontrol first to test for syntax errors (as you can't trap syntax errors, but you can trap the runtime error the script control gives off on a syntax error).
So you can build your program at runtime.
Set Arg = WScript.Arguments
set WshShell = createObject("Wscript.Shell")
Set Inp = WScript.Stdin
Set Outp = Wscript.Stdout
Sub VBSCmd
RawScript = LCase(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"
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
the funny thing about function objects is that they by definition are a memory leak. This means that once you create a function object, you need to keep the scope it was created in intact, which threw me off.
Class VBCompiler
Public leaks
Public Sub Class_Initialize()
leaks = Array()
End Sub
Public Function Compile(code)
Dim compiler, result
Set compiler = CreateObject("MSScriptControl.ScriptControl")
Set portal = CreateObject("Scripting.Dictionary")
Dim name
compiler.Language = "VBScript"
compiler.AddObject "portal", portal, True
compiler.ExecuteStatement code
name = compiler.Procedures(1).Name
compiler.ExecuteStatement "portal.Add ""result"", GetRef(""" & name & """)"
' save the script control because if we go out of scope...
' our function object goes poof!
' leaks.Push compiler
ReDim Preserve leaks(UBound(leaks) + 1)
Set leaks(UBound(leaks)) = compiler
Set Compile = portal("result")
End Function
End Class
Dim z
Set z = New VBCompiler
Set z2 = z.Compile("Function Foo(s):MsgBox s:Foo = 2:End Function")
z2("Hi!")
z2 "Hello Again!"
Gives the two message boxes as desired
Class VBCompiler
Public Function Compile(code)
Dim compiler, result
Set compiler = CreateObject("MSScriptControl.ScriptControl")
Set portal = CreateObject("Scripting.Dictionary")
Dim name
compiler.Language = "VBScript"
compiler.AddObject "portal", portal, True
compiler.ExecuteStatement code
name = compiler.Procedures(1).Name
compiler.ExecuteStatement "portal.Add ""result"", GetRef(""Foo"") "
Set Compile = portal("result")
End Function
End Class
Dim z
Set z = New VBCompiler
Set z2 = z.Compile("Function Foo():MsgBox ""Well Met!"":Foo = 2:End Function")
z2("Hi!")
z2 "Hello Again!"
The above gives (29, 5) (null): Unspecified error. This error is in essence: your object has committed suicide.
This approach can be improved(in particular, the issue of wasteful one ScriptControl per compilation without any plans to release them).
I have a vbscript that calls a second vbscript and runs a function. This second function returns a value. But I can't figure out how to get this value, as the result of the first function returns the status code.
original call: fileCASTRING(12345678)
vbscript 1
function fileCASTRING(varRAW)
lresult = CreateObject("WScript.Shell").Run ("c:\windows\syswow64\cscript.exe C:\ERMXData\Config\query-castring.vbs " & varRAW,0,true)
fileCASTRING=1
end function
query-castring.vbs
doctype=WScript.Arguments.Item(0)
Dim strCon
strCon = "DSN=*****; " & _
"uid=*****;pwd=*****;"
Dim oCon: Set oCon = WScript.CreateObject("ADODB.Connection")
Dim oRs: Set oRs = WScript.CreateObject("ADODB.Recordset")
oCon.Open strCon
Set oRs = oCon.Execute("select ESBLINK_ADMR_CODE from ESBLINK where ESBLINK_DTYP_CODE like '%" + doctype + "%'"")
queryB=oRs.Fields(0).Value
oCon.Close
Set oRs = Nothing
Set oCon = Nothing
I have to do it like this because the program that runs vbscript 1 runs in 64 bit mode and the code in query-castring.vbs needs to run in 32bit mode in order for it to work. How can I get the queryB value back to the original caller? I am trying to not have to write the value to a file.
The only easy way to communicate between two command line processes is via StdOut.
(Be aware the code is not tested but should get you into the right direction.)
VBScript 1
Option Explicit
' ...
Function fileCASTRING(varRAW)
Dim program, script, cmdline, output
program = "c:\windows\syswow64\cscript.exe /nologo"
script = "C:\ERMXData\Config\query-castring.vbs"
cmdLine = program & " " script & " """ & varRAW & """"
output = ""
With CreateObject("WScript.Shell").Exec(cmdLine)
While Not .StdOut.AtEndOfStream
output = output & .StdOut.ReadAll
Wend
End With
fileCASTRING = output
End Function
see the documentation of the WshScriptExec object
query-castring.vbs
Option Explicit
Dim doctype: doctype = WScript.Arguments.Item(0)
Dim strCon: strCon = "DSN=*****;uid=*****;pwd=*****;"
Dim strSql: "select ESBLINK_ADMR_CODE from ESBLINK where ESBLINK_DTYP_CODE like '%' + ? + '%'"
Dim oCon: Set oCon = WScript.CreateObject("ADODB.Connection")
Dim oCmd: Set oCmd = WScript.CreateObject("ADODB.Command")
oCon.Open strCon
With WScript.CreateObject("ADODB.Command")
Set .ActiveConnection = oCon
.CommandText = strSql
.Parameters.Add(.CreateParameter)
.Parameters(0).Value = doctype
With .Execute
If Not .EOF Then
WScript.Echo .Fields("ESBLINK_ADMR_CODE").Value
End If
End With
End With
oCon.Close
See the documentation of the ADODB Command and Parameter objects. Don't build SQL from strings.
Also, look into "integrated security" connection strings - do not store plain text passwords in in code files. ADODB can easily use the security context of the account that runs the script, if you tell it to.
VBScript 1
Function getADMRCODE(varRAW)
Dim program, script, cmdline, output
program = "c:\windows\syswow64\cscript.exe /nologo"
script = "C:\ERMXData\Config\common_app\queries\admrcode.vbs"
cmdLine = program & " " & script & " """ & varRAW & """"
output = ""
With CreateObject("WScript.Shell").Exec(cmdLine)
While Not .StdOut.AtEndOfStream
output = output & .StdOut.ReadAll
Wend
End With
getADMRCODE = output
End Function
query-castring.vbs
Dim doctype: doctype = WScript.Arguments.Item(0)
Dim strCon
strCon = "DSN=*****; " & _
"uid=*****;pwd=*****;"
Dim oCon: Set oCon = WScript.CreateObject("ADODB.Connection")
Dim oRs: Set oRs = WScript.CreateObject("ADODB.Recordset")
oCon.Open strCon
Set oRs = oCon.Execute("select ESBLINK_ADMR_CODE from ESBLINK where ESBLINK_DTYP_CODE LIKE '%" + doctype + "%'")
WScript.Echo oRs.Fields(0).Value
oCon.Close
Set oRs = Nothing
Set oCon = Nothing
I am trying to join the arguments to a string to be passed to another script. The following:
WScript.Echo(Join(WScript.Arguments))
gives me an error:
Error: Wrong number of arguments or invalid property assignment
Code: 800A01C2
What is wrong with that syntax?
WshArgument objects are not arrays, so you can't use Join() on them. What you can do is something like this:
ReDim arr(WScript.Arguments.Count-1)
For i = 0 To WScript.Arguments.Count-1
arr(i) = WScript.Arguments(i)
Next
WScript.Echo Join(arr)
Another solution can be done with ArrayList object from the system:
Set oAL = CreateObject("System.Collections.ArrayList")
For Each oItem In Wscript.Arguments: oAL.Add oItem: Next
WScript.Echo Join(oAL.ToArray, " ")
ReDim arr(WScript.Arguments.Count-1)
For i = 0 To WScript.Arguments.Count-1
arr(i) = """"+WScript.Arguments(i)+""""
Next
WScript.Echo Join(arr)
this will add quotes for each argument,
you can then remove it in the batch file with %~1 and so on.
Here is the function that I use. It will return all the arguments whether they contain quotes or not in a string that you can pass to another script.
Function GetArguments()
Dim Args, Arg
If WSH.Arguments.Count > 0 Then
For Each Arg In WSH.Arguments
Args = Args & """" & Arg & """ "
Next
Args = " """"" & Trim(Args) & """"""
End If
GetArguments = Args
End Function
What is the stackoverflow approved (and hence correct) method to force a VBS to run using cscript instead of wscript - irrespective of what the user tries?
A quick Google search shows plenty of examples, but some of them simply don't work and those which do often don't handle the fact that it may have been run with arguments so I'm keen to know what the best way is.
Here is one example which doesn't handle arguments:
sExecutable = LCase(Mid(Wscript.FullName, InstrRev(Wscript.FullName,"\")+1))
If sExecutable <> "cscript.exe" Then
Set oShell = CreateObject("wscript.shell")
oShell.Run "cscript.exe """ & Wscript.ScriptFullName & """"
Wscript.Quit
End If
I appreciate that this could probably be easily modified to handle arguments, but realise that this may not be the best way to approach the problem.
Background: I'm writing a script which can run by double clicking or (most likely) from either a DOS batch file or as a scheduled task. It can contain one or more optional command line arguments.
My Lord, what unadulterated rubbish. It makes me cry to see such cruddy coding (no offense to anybody, lol). Seriously, though, here's my 2 pence:
Sub forceCScriptExecution
Dim Arg, Str
If Not LCase( Right( WScript.FullName, 12 ) ) = "\cscript.exe" Then
For Each Arg In WScript.Arguments
If InStr( Arg, " " ) Then Arg = """" & Arg & """"
Str = Str & " " & Arg
Next
CreateObject( "WScript.Shell" ).Run _
"cscript //nologo """ & _
WScript.ScriptFullName & _
""" " & Str
WScript.Quit
End If
End Sub
forceCScriptExecution
It handles arguments, AND checks for spaces in said arguments -- so that in the case of a filename passed to the original script instance that contained spaces, it wouldn't get "tokenized" when passed to cscript.exe.
Only thing it doesn't do is test for StdIn (e.g., in the case where someone piped something to the script via the command line, but forgot to use "cscript script.vbs") -- but if it was executed by WScript.exe, WScript.StdIn's methods all return Invalid Handle errors, so there's no way to test that anyway.
Feel free to let me know if there's a way to "break" this; I'm willing to improve it if necessary.
Two small additions to forceCScriptExecution let me see its Window after termination and handle its return code.
Sub forceCScriptExecution
Dim Arg, Str
If Not LCase( Right( WScript.FullName, 12 ) ) = "\cscript.exe" Then
For Each Arg In WScript.Arguments
If InStr( Arg, " " ) Then Arg = """" & Arg & """"
Str = Str & " " & Arg
Next
**ret =** CreateObject( "WScript.Shell" ).Run **("cmd /k** cscript //nologo """ & WScript.ScriptFullName & """ " & Str**,1,true)**
WScript.Quit **ret**
End If
End Sub
Notes: "cmd /k" let the windows stay after execution. Parameter "1" activates the window. Parameter "true" waits for termination, so variable "ret" can return the error code.
Here's a similar one in JScript for making .js files run in CScript:
(function(ws) {
if (ws.fullName.slice(-12).toLowerCase() !== '\\cscript.exe') {
var cmd = 'cscript.exe //nologo "' + ws.scriptFullName + '"';
var args = ws.arguments;
for (var i = 0, len = args.length; i < len; i++) {
var arg = args(i);
cmd += ' ' + (~arg.indexOf(' ') ? '"' + arg + '"' : arg);
}
new ActiveXObject('WScript.Shell').run(cmd);
ws.quit();
}
})(WScript);
WScript.echo('We are now in CScript. Press Enter to Quit...');
WScript.stdIn.readLine();
https://gist.github.com/4482361
One approach might be to give it another extension instead of .vbs. Say .cvbs for example. Associate .cvbs with cscript.exe not wscript.exe, that way executing or double clicking a .cvbs file will never invoke the wscript.exe.
Here is my code snippet i use for some of my scripts. It handles Arguments as well. All you have to do is replace the {EnterWorC} with either a "w" or "c" WITH quotes
Dim WorC, Command, Arguments, I
WorC={EnterWOrC} 'Make sure you replace "{EnterWOrC}" with a "w" or a "c" and BE SURE TO PUT QUOTES AROUND THE LETTER.
WorC=LCase (WorC)
If lcase (WorC)="w" Or lcase (WorC)="c" Then
If LCase (Right (WScript.FullName,11))<> WorC & "script.exe" Then
command=WScript.ScriptFullName
Arguments=""
For I=0 To UBound (WScript.Arguments)
Arguments=Arguments & Chr (34) & WScript.Arguments(I) & Chr (34) & Space (1)
Next
CreateObject("Wscript.Shell").Run WorC & "script.exe " & Chr (34) & command & Chr (34) & Space (1) & Arguments, 1
WScript.Quit
End If
WorC=Empty
Command=Empty
I=Empty
Arguments=Empty
End If
Here you will have to replace the 2nd line (2nd NON-blank line)
WorC={EnterWOrC} 'Make sure you replace "{EnterWOrC}" with a "w" or a "c" and BE SURE TO PUT QUOTES AROUND THE LETTER.
For Wscript: WorC="W"
For CScript: WorC="C"
It is NOT case Sensitive.
I'm working on a project to capture various disk performance metrics using VBScript and would like to use a sub procedure with an object as an argument. In the following code samples the object I'm referring to is objitem.AvgDiskQueueLength which will provide a value for the disk queue length. I haven't found a way to make it work since it is recognized as a string and then doesn't capture the value. My goal is to make it easy for anyone to change the counters that are to be captured by only having to make a change in one location(the procedure call argument). The way I'm going about this may not be the best but I'm open to suggestions. The sub procedure call is below.
PerfCounter "Average Disk Queue Length", "disk_queueLength", "objItem.AvgDiskQueueLength"
The following code is the sub procedure.
Sub PerfCounter(CounterDescription, CounterLabel, CounterObject)
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_PerfFormattedData_PerfDisk_PhysicalDisk",,48)
args_index = args_index + 1
arrCriteria = split(command_line_args(args_index),",")
strDriveLetter = UCase(arrCriteria(0))
intCriticalThreshold = arrCriteria(1)
intWarningThreshold = arrCriteria(2)
For Each objItem in colItems
With objItem
WScript.Echo "objitem.name = " & objitem.name
If InStr(objItem.Name, strDriveLetter & ":") > 0 Then
intChrLocation = InStr(objItem.Name, strDriveletter)
strInstanceName = Mid(objItem.Name, intChrLocation, 1)
End If
If strDriveLetter = strInstanceName AND InStr(objItem.Name, strDriveLetter & ":") > 0 Then
If intActiveNode = 1 OR Len(intActiveNode) < 1 Then
WScript.Echo "CounterDescription = " & CounterDescription
WScript.Echo "CounterLabel = " & CounterLabel
WScript.Echo "CounterObject = " & CounterObject
If CInt(CounterOjbect) => CInt(intCriticalThreshold) Then
arrStatus(i) = "CRITICAL: " & strDriveLetter & ": " & CounterDescription
arrTrendData(i) = CounterLabel & "=" & CounterObject
intExitCode = 2
arrExitCode(i) = intExitCode
ElseIf CInt(CounterOjbect) => CInt(intWarningThreshold) AND CInt(CounterObject) < CInt(intCriticalThreshold) Then
arrStatus(i) = "WARNING: " & strDriveLetter & ": " & CounterDescription
arrTrendData(i) = CounterLabel & "=" & CounterObject
intExitCode = 1
arrExitCode(i) = intExitCode
Else
arrStatus(i) = "OK: " & strDriveLetter & ": " & CounterDescription
arrTrendData(i) = CounterLabel & "=" & CounterObject
intExitCode = 0
arrExitCode(i) = intExitCode
End If
Else
PassiveNode CounterDescription, CounterLabel
End If
End If
End With
Next
i = i + 1
ReDim Preserve arrStatus(i)
ReDim Preserve arrTrendData(i)
ReDim Preserve arrExitCode(i)
End Sub
Why cant you do this...
PerfCounter "Average Disk Queue Length", "disk_queueLength", objItem.AvgDiskQueueLength
To pass an object you have to pass an object, not a string. To make this method work as expected you would have to have the object prior to the procedure call, but in your code example it looks like you are trying to pass an object that you don't have. A working example:
Set objFSO = CreateObject("Scripting.FileSystemObject")
UseFileSystemObject objFSO
Sub UseFileSystemObject( objfso)
'Now I can use the FileSystemObject in this procedure.
End Sub
But calling the UseFileSystemObject procedure like this will not work,
UseFileSystemObject "objFSO"
because you are passing in a string not an object.
The only way I can think of to accomplish what you want is to use a select statement to write the appropriate attribute of the object, something like this.
Call PerfCounter "Average Disk Queue Length", "disk_queueLength", "AvgDiskQueueLength"
Sub PerfCounter(CounterDescription, CounterLabel, CounterObjectAttribute)
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_PerfFormattedData_PerfDisk_PhysicalDisk",,48)
For Each objItem in colItems
Select Case CounterObjectAttribute
Case "ObjectAttribute1"
Case "ObjectAttribute2"
Case "AvgDiskQueueLength"
Wscript.Echo objItem.AvgDiskQueueLength
End Select
Next
End Sub
So in the select you would have to add a case for each attribute that can be used, but it would allow you to pass a string into the procedure. I might be way off on this, but I don't know how you can pass an object if you don't have the object first.