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