ScriptControl 应用

ScriptControl接口 属性名称 类型 备注 AllowUI BOOL 检测是否允许运行用户的接口元素。如果为False，则诸如消息框之类的界面元素不可见。 CodeObject Object 脚本暴露给宿主调用的对象。只读。 Modules Modules 宿主提供给脚本的组件库模块。只读。（COM组件通常都是以对象收集的形式向用户提供可以留给用户二次开发的对象集合，每一个收集即一个Modules） Language String 设置或获取脚本引擎解释的语言，例如：VBScript、JScript。 Name String 脚本引擎的名称。只读。 Procedures Procedures 返回模块中定义的过程的集合 SitehWnd HWND 在脚本中显示UI的父窗口句柄 State Enum 设置或返回控件的状态，如果为0，控件只执行语句但不转发事件，为1则为加入的本控件接受的对象转发事件。 Timeout Long 控件的执行脚本的超时值，－1表示不超时 UseSafeSubset BOOL 设置或返回宿主程序是否关心安全。宿主程序的安全级别可以从此属性设置 Error Error 错误对象，发生错误时，此属性返回一个错误对象   方法名称 参数 功能 AddCode Code As String 往脚本引擎中加入要执行的脚本 AddObject Name As String, Object As Object, [AddMembers As Boolean = False] 往脚本引擎加入一个对象,以便在脚本中可以使用该对象提供的方法等。 Eval Expression As String 表达式求值 ExecuteStatement Statement As String 解释并执行脚本语句 Reset   丢弃所有的对象和代码，将State属性置0。 Run ProcedureName As String, ParamArray Parameters() As Variant 运行一个指定的过程   事件名称 功能 Error 有错误发生时激发该事件 TimeOut 执行过程超时时发生  

下面是自己写例子： Form1.frm 文件

VERSION 5.00Object = "{0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}#1.0#0"; "msscript.ocx"Begin VB.Form Form1    BorderStyle     =   1  'Fixed Single   Caption         =   "Form1"   ClientHeight    =   3975   ClientLeft      =   45   ClientTop       =   435   ClientWidth     =   9495   LinkTopic       =   "Form1"   MaxButton       =   0   'False   MinButton       =   0   'False   ScaleHeight     =   3975   ScaleWidth      =   9495   StartUpPosition =   3  'Windows Default   Begin VB.CommandButton Command7       Caption         =   "test"      Height          =   375      Left            =   240      TabIndex        =   10      Top             =   3120      Width           =   1455   End   Begin VB.CommandButton Command5       Caption         =   "test"      Height          =   375      Left            =   240      TabIndex        =   9      Top             =   2640      Width           =   1455   End   Begin VB.CommandButton Command6       Caption         =   "test"      Height          =   375      Left            =   240      TabIndex        =   7      Top             =   240      Width           =   1455   End   Begin VB.CommandButton Command4       Caption         =   "读取代码"      Height          =   375      Left            =   240      TabIndex        =   6      Top             =   2160      Width           =   1455   End   Begin MSScriptControlCtl.ScriptControl ScriptControl1       Left            =   -360      Top             =   0      _ExtentX        =   1005      _ExtentY        =   1005   End   Begin VB.ListBox List2       Height          =   1035      Left            =   5160      TabIndex        =   5      Top             =   2160      Width           =   4215   End   Begin VB.ListBox List1       Height          =   1035      Left            =   1920      TabIndex        =   4      Top             =   2160      Width           =   2895   End   Begin VB.TextBox text1       Height          =   2055      Left            =   1920      MultiLine       =   -1  'True      ScrollBars      =   2  'Vertical      TabIndex        =   3      Text            =   "Form1.frx":0000      Top             =   0      Width           =   7455   End   Begin VB.CommandButton Command3       Caption         =   "Command1"      Height          =   375      Left            =   240      TabIndex        =   2      Top             =   1680      Width           =   1455   End   Begin VB.CommandButton Command2       Caption         =   "Command1"      Height          =   375      Left            =   240      TabIndex        =   1      Top             =   1200      Width           =   1455   End   Begin VB.CommandButton Command1       Caption         =   "Command1"      Height          =   375      Left            =   240      TabIndex        =   0      Top             =   720      Width           =   1455   End   Begin VB.Label labshow       Height          =   375      Left            =   1920      TabIndex        =   8      Top             =   3360      Width           =   7455   EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption ExplicitDim CodeStr As StringDim m, p As Variant Private Sub Command2_Click()    If Trim(text1.Text) = "" Then Exit Sub    List1.Clear    With ScriptControl1        .Reset        .Language = "VBScript"        .AllowUI = True        .Modules.Add "MyMod"                               '好像名称不能用：ModVbscript        .AddObject "MyForm", Form1, True        For Each p In .Modules            List1.AddItem p.Name        Next    End With     Set m = ScriptControl1.Modules("MyMod")    List1.Text = "MyMod"     CodeStr = text1.Text    ScriptControl1.Modules(List1).AddCode CodeStr    List1_ClickEnd Sub Private Sub Command3_Click() '    If Len(Trim(List1.Text)) = 0 Then Exit Sub    If Len(Trim(List2.Text)) = 0 Then Exit Sub    Dim RetVal As Variant, m As Variant'    Set m = ScriptControl1.Modules(List1.Text)    Set m = ScriptControl1.Modules("MyMod")        With m.Procedures(List2.Text)         Select Case .NumArgs            Case 0                RetVal = m.Run(List2.Text)            Case 1                RetVal = m.Run(List2.Text, 5)            Case 2                RetVal = m.Run(List2.Text, 4, 23)            Case Else                labshow.Caption = "Procedure has too many arguments"        End Select        If .HasReturnValue Then            labshow.Caption = List2.Text & " returned: " & RetVal        End If    End WithEnd Sub Private Sub Command4_Click()    Dim FileName As String    Dim FileStr As String    Dim FreeF As Integer                                   '空闲的文件号    Dim LenFile As Long                                    '文件的长度    Dim bytData() As Byte                                  '存放数据的数组    FileName = App.Path & "/vbscript.vbs"    FreeF = FreeFile                                       '获得空闲的文件号     Open FileName For Binary As #FreeF                     '打开文件    LenFile = LOF(FreeF)                                   '获得文件长度    ReDim bytData(1 To LenFile)                            '根据文件长度重新定义数组大小    Get #FreeF, , bytData                                  '把文件读入到数组里    Close #FreeF                                           '关闭文件    FileStr = StrConv(bytData, vbUnicode)    text1.Text = FileStrEnd Sub  Private Sub Command5_Click()'    m.CodeObject.x = 1'    m.CodeObject.y = 7'    labshow.Caption = m.CodeObject.x + m.CodeObject.y     labshow.Caption = m.Run("calc", m.CodeObject.x, m.CodeObject.y)     End Sub Private Sub Command6_Click() On Error GoTo command6Err m.Run "ChangeCaption", 1 Exit Subcommand6Err: End Sub Private Sub Command7_Click() On Error GoTo command6Err m.CodeObject.Myc.m = 2 m.CodeObject.Myc.id = 6 labshow.Caption = m.CodeObject.Myc.CalcMe(m.CodeObject.Myc.m, m.CodeObject.Myc.id)' labshow.Caption = m.CodeObject.Myc.CalcMe(2, 5) Exit Subcommand6Err:End Sub Private Sub Form_Load()    List1.Clear    With ScriptControl1        .Language = "VBScript"        .AllowUI = True        .Modules.Add "MyMod"                               '好像名称不能用：ModVbscript        .AddObject "MyForm", Form1, True        For Each m In .Modules            List1.AddItem m.Name        Next m    End With    List1.Text = "MyMod"     Dim FileName As String    Dim FileStr As String    Dim FreeF As Integer                                   '空闲的文件号    Dim LenFile As Long                                    '文件的长度    Dim bytData() As Byte                                  '存放数据的数组    FileName = App.Path & "/vbscript.vbs"    FreeF = FreeFile                                       '获得空闲的文件号     Open FileName For Binary As #FreeF                     '打开文件    LenFile = LOF(FreeF)                                   '获得文件长度    ReDim bytData(1 To LenFile)                            '根据文件长度重新定义数组大小    Get #FreeF, , bytData                                  '把文件读入到数组里    Close #FreeF                                           '关闭文件    FileStr = StrConv(bytData, vbUnicode)    text1.Text = FileStr    CodeStr = FileStr     ScriptControl1.Modules("MyMod").AddCode CodeStr        List2.Clear    For Each p In ScriptControl1.Modules("MyMod").Procedures        List2.AddItem p.Name    Next p     Set m = ScriptControl1.Modules("MyMod")    m.Run "ChangeCaption", 0 End Sub Private Sub List1_Click()    Dim m As String, p As Variant    m = List1    List2.Clear    If m = "" Then Exit Sub    For Each p In ScriptControl1.Modules(m).Procedures        List2.AddItem p.Name    Next pEnd Sub Private Sub List2_Click()    Dim m As String, p As String, r As Boolean, a As Long    m = List1    p = List2    With ScriptControl1.Modules("MyMod").Procedures(p)        r = .HasReturnValue        a = .NumArgs    End With    labshow.Caption = m & "." & p & " has " & IIf(r, "a", "no") & _                     " return value and " & a & " arguments"End Sub   vbscript.vbs 文件如下： dim x  dim ydim zDim MyC Class Myname    dim m    dim Id    dim Ret    function CalcMe(a,b)        CalcMe=a*b    end functionEnd Class Set MyC = new MynameMyC.m=2MyC.id=9MyC.ret=MyC.CalcMe(MyC.m,MyC.id) x=2000y=8z=x*y Function Test()     dim i       Myform.Caption = "I love you"     myform.command4.caption ="你好"     ChangeCaption  i     i= not iEnd FunctionSub Command6_Click()    myform.command6.caption ="北京奥运会"End Sub sub ChangeCaption(flag)     with Myform     if flag=0 then      .Caption = "vbscript Demo"      .command4.Caption="Rend code"      .command6.Caption="Only Test"      .Command1.Caption = "Add Module"      .Command2.Caption = "Add Code"      .Command3.Caption = "Run Procedure"      .Command5.Caption = "Run Calc"      .Command7.Caption = "Run Class sub"     else      .Caption = "vbscript 演示"      .command4.Caption="读取代码"      .command6.Caption="测试"      .Command1.Caption = "增加模块"      .Command2.Caption = "增加代码"      .Command3.Caption = "执行函数"      .Command5.Caption = "计算"      .Command7.Caption = "执行类中的函数"     end if     end withEnd sub function calc(a,b)     calc=a+bend function