VBScript Higher-Order Functions

Question

Is there a way to write anonymous functions, pass them to other functions, in which they are invoked, in vbscript?

Answer 1

1. There are no anonymous functions/subs/methods in VBScript.
2. 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.
3. 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.

Answer 2

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

Answer 3

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).