VBScript 高阶函数

Question

有没有办法在 vbscript 中编写匿名函数，将它们传递给调用它们的其他函数？

Answer 1

VBScript 中没有匿名functions/subs/methods。
您可以使用 GetRef()（请参阅 sample1, sample2）获取函数指针之类的东西，可以将其传递给 functions/subs 以在那里调用（回调）。但是在 VBScript 中没有闭包，所以在其他语言中可能的技巧在 VBScript 中失败了。
对于可以用函数式语言中的高阶函数解决的特定问题，可能存在（几乎）等效的涉及 classes/objects 的 VBScript 解决方案；但是要讨论该方法，您需要 your/such 详细描述一个问题。

Answer 2

VBScript 具有执行任意代码的能力。

Execute 和 Eval 只是对包含代码的字符串执行它们所说的操作。

ExecuteGlobal 向您的程序添加代码，如新函数、新变量。

Script Control 将 vbscript/jscript 脚本语言添加到任何程序，包括 vbscripts。它可以访问主机的数据。

如果使用 ExecuteGlobal/Execute/Eval，最好先通过脚本控件运行来测试语法错误（因为您无法捕获语法错误，但可以捕获运行脚本控件因语法错误而发出时间错误）。

因此您可以在运行时间构建您的程序。

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"

使用冒号分隔语句和行。使用单引号代替双引号，如果您需要单引号，请使用 chr(39)。使用 ^ 字符转义括号和符号。如果您需要插入符号，请使用 chr(136).

该函数称为 UF（对于 UserFunction）。它有两个参数，包含当前行的 L 和包含行数的 LC。将脚本的结果设置为 UF。参见示例。

共有三个全局对象可用。一个未声明的全局变量 gU 来维护状态。如果您需要多个变量，请将其用作数组。用于保存和访问前几行的字典对象 gdU。以及一个可供使用的 RegExp 对象 greU。

示例

此 vbs 脚本插入行号并将行设置为过滤器打印的函数 UF。

filter vbs "uf=LC ^& ' ' ^& L"<"%systemroot%\win.ini"

这是它在记忆中的样子

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

如果存在语法错误，过滤器将显示调试详细信息。

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

函数对象的有趣之处在于它们根据定义是内存泄漏。这意味着一旦你创建了一个函数对象，你需要保持它被创建的范围完好无损，这让我很失望。

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!"

根据需要给出两个消息框

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!"

以上给出(29, 5) (null): Unspecified error。这个错误本质上是：your object has committed suicide.

这种方法可以改进（特别是每次编译浪费一个 ScriptControl 的问题，没有任何发布它们的计划）。

VBScript 高阶函数

VBScript Higher-Order Functions

vbscript

functional-programming