VBScript腳本運用（腳本程式與宿主程式的互動）

做過工控的人都知道，對腳本語言的支援是标準組态軟體應具備的一個基本功能（如iFix，組态王等）。如果我們用VB開發類似的功能，能實作嗎？

想必大家都知道微軟提供了Micrsoft Script Control 1.0 控件，在VB版也見到了大家對這個控件的使用（如用ExecuteStatement方法執行腳本指令 ExecuteStatement（"msgbox “你好””）??? ）。但最重要的一點，ActiveX腳本與宿主應用程式資料互動與傳遞，卻沒有完整的解決方案。

我也是探索了很長一段時間，才摸索出一點資料傳遞與互動的技巧，現在共享出來，供大家讨論研究。

示例程式介紹：

1、首先加載Micrsoft Script Control 1.0 控件。

對它基本上不用配置，預設語言VBScript，對該部分的介紹請下載下傳VBScript指令集 （

http://blog.csdn.net/yefanqiu

   【葉帆資源】[03] VBScript指令集）

2、添加一個窗體（frmTest），裡面添加如下代碼：

**********************************************************************
'**模 塊 名：frmTest
'**說    明：YFsoft 版權所有2004 - 2005(C)
'**創 建 人：葉帆
'**日    期：2004-10-15 11:00:32
'**修 改 人：
'**日    期：
'**描    述：腳本語言運用探索
'**版    本：V1.0.0
'*************************************************************************
Option Explicit
'*************************************************************************
'**函 數 名：chkRun_Click
'**輸    入：無
'**輸    出：無
'**功能描述：腳本運作控制
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 11:19:31
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub chkRun_Click()
If chkRun.value = 1 Then
tmrRun.Interval = cmbRunTime.Text                          '運作間隔
tmrRun.Enabled = True                                      '開始運作  以固定間隔循環運作
txtEdit.Enabled = False
Else
tmrRun.Enabled = False                                     '停止運作
txtEdit.Enabled = True
End If
End Sub
'*************************************************************************
'**函 數 名：cmbType_Click
'**輸    入：無
'**輸    出：無
'**功能描述：操作類型切換
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 12:56:19
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub cmbType_Click()
cmdSCDemo1_Click
End Sub
'*************************************************************************
'**函 數 名：cmdRun_Click
'**輸    入：無
'**輸    出：無
'**功能描述：單次運作腳本
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 11:51:29
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub cmdRun_Click()
Call tmrRun_Timer
End Sub
'*************************************************************************
'**函 數 名：cmdSCDemo1_Click
'**輸    入：無
'**輸    出：無
'**功能描述：參數傳遞示範
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 11:03:29
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub cmdSCDemo1_Click()
Dim strType As String
'内部變量定義  類似組态王中的資料字典
valMem.Clear
valMem.SetValue "Value1", txtValue(0)
valMem.SetValue "Value2", txtValue(1)
valMem.SetValue "Value3", 0
Select Case cmbType.ListIndex
Case 0:
strType = "+"
Case 1:
strType = "-"
Case 2:
strType = "*"
Case 3:
strType = "/"
End Select
txtEdit = "dim lngValue1" & vbCrLf
txtEdit = txtEdit & "dim lngValue2" & vbCrLf
txtEdit = txtEdit & "dim lngValue3" & vbCrLf
txtEdit = txtEdit & "lngValue1=vm.getvalue(" & Chr(34) & "Value1" & Chr(34) & ")" & vbCrLf
txtEdit = txtEdit & "lngValue2=vm.getvalue(" & Chr(34) & "Value2" & Chr(34) & ")" & vbCrLf
txtEdit = txtEdit & "lngValue3=CInt(lngValue1)" & strType & "CInt(lngValue2)" & vbCrLf
txtEdit = txtEdit & "vm.setvalue " & Chr(34) & "Value3" & Chr(34) & ",lngValue3 " & vbCrLf
End Sub
'*************************************************************************
'**函 數 名：cmdSCDemo2_Click
'**輸    入：無
'**輸    出：無
'**功能描述：對象操作示範
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 13:41:23
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub cmdSCDemo2_Click()
txtEdit = "dim lngC" & vbCrLf
txtEdit = txtEdit & "lngC=clng(fm.txtdemo.text)" & vbCrLf
txtEdit = txtEdit & "lngC=lngC+10" & vbCrLf
txtEdit = txtEdit & "if lngC>255 then lngC=0" & vbCrLf
txtEdit = txtEdit & "fm.picdemo.backcolor=rgb(lngC,0,0)" & vbCrLf
txtEdit = txtEdit & "fm.txtdemo.text=cstr(lngC)" & vbCrLf
End Sub
'*************************************************************************
'**函 數 名：Form_Load
'**輸    入：無
'**輸    出：無
'**功能描述：初始化
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 11:13:03
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub Form_Load()
'添加參數運用的  内部可使用的變名  外部實際變量名
scCommand.AddObject "vm", valMem, True
'向腳本添加外部可用的對象
'最後一個參數: True表示它的子類屬性方法在腳本中可以操作  false 表示今該對象本身的方法屬性可用
scCommand.AddObject "fm", Me, True
'腳本運作間隔設定
cmbRunTime.ListIndex = 0
'參數操作類型
cmbType.ListIndex = 0
End Sub
'*************************************************************************
'**函 數 名：tmrRun_Timer
'**輸    入：無
'**輸    出：無
'**功能描述：腳本運作
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 11:29:46
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Private Sub tmrRun_Timer()
On Error GoTo ToExit '打開錯誤陷阱
'------------------------------------------------
Dim i As Long
'參數輸入
valMem.SetValue "Value1", txtValue(0).Text
valMem.SetValue "Value2", txtValue(1).Text
valMem.SetValue "Value3", 0
'腳本運作
scCommand.ExecuteStatement txtEdit.Text
'參數輸出
lstValueOut.Clear
For i = 1 To valMem.Count
lstValueOut.AddItem valMem.GetValue("", i)
Next
'------------------------------------------------
Exit Sub
'----------------
ToExit:
txtError = "錯 誤 号:" & Err.Number & "   時間:" & Format(Now, "YYYY-MM-DD HH:MM:SS") & vbCrLf
txtError = txtError & "錯誤資訊:" & Err.Description & vbCrLf
txtError = txtError & "錯誤來源:" & Err.Source
End Sub
           

3、添加一個子產品（mdlBase），裡面添加如下代碼：

**********************************************************************
'**模 塊 名：mdlBase
'**說    明：YFsoft 版權所有2004 - 2005(C)
'**創 建 人：葉帆
'**日    期：2004-10-15 11:10:58
'**修 改 人：
'**日    期：
'**描    述：公共變量區
'**版    本：V1.0.0
'*************************************************************************
Option Explicit
Public valMem As New clsScriptIO     '腳本語言參數交換的變量設定區           

添加一個類（clsScriptIO），類名為clsScriptIO，裡面添加如下代碼：

**********************************************************************
'**模 塊 名：clsScriptIO
'**說    明：YFsoft 版權所有2004 - 2005(C)
'**創 建 人：葉帆
'**日    期：2004-10-15 11:56:32
'**修 改 人：
'**日    期：
'**描    述：與腳本語言參數互動的類子產品
'**版    本：V1.0.0
'*************************************************************************
Option Explicit
Private cltScriptMem As New Collection     '變量設定區
'*************************************************************************
'**函 數 名：Count
'**輸    入：無
'**輸    出：(Variant) -
'**功能描述：記憶體變量個數
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 12:00:57
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Property Get Count() As Variant
Count = cltScriptMem.Count
End Property
'*************************************************************************
'**函 數 名：GetValue
'**輸    入：strKey(String) - 變量名稱
'**        ：Optional lngNo(Long = 0) - 變量索引
'**輸    出：(Variant) - 傳回值
'**功能描述：取得制定名稱的變量值
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 12:01:59
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Function GetValue(strKey As String, Optional lngNo As Long = 0) As Variant
On Error GoTo ToExit '打開錯誤陷阱
'------------------------------------------------
If lngNo > 0 Then    '如果輸入索引号，則傳回索引号指定的變量
GetValue = cltScriptMem.Item(lngNo)
Else
GetValue = cltScriptMem.Item(strKey)
End If
'------------------------------------------------
Exit Function
'----------------
ToExit:
End Function
'*************************************************************************
'**函 數 名：SetValue
'**輸    入：strKey(String) - 變量名
'**        ：value(Variant) - 設定變量
'**輸    出：無
'**功能描述：為指定的變量指派
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 12:07:05
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Sub SetValue(strKey As String, value As Variant)
On Error GoTo ToExit '打開錯誤陷阱
'------------------------------------------------
cltScriptMem.Remove (strKey)
cltScriptMem.Add value, strKey
'------------------------------------------------
Exit Sub
'----------------
ToExit:
Resume Next
End Sub
'*************************************************************************
'**函 數 名：DelValue
'**輸    入：strKey(String) - 變量名
'**        ：Optional lngNo(Long = 0) -索引号
'**輸    出：無
'**功能描述：删除制定的變量
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 12:08:55
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Sub DelValue(strKey As String, Optional lngNo As Long = 0)
On Error GoTo ToExit '打開錯誤陷阱
'------------------------------------------------
If lngNo > 0 Then    '如果輸入索引号，則删除索引号指定的變量
cltScriptMem.Remove (lngNo)
Else
cltScriptMem.Remove (strKey)
End If
'------------------------------------------------
Exit Sub
'----------------
ToExit:
End Sub
'*************************************************************************
'**函 數 名：Clear
'**輸    入：無
'**輸    出：無
'**功能描述：删除變量
'**全局變量：
'**調用子產品：
'**作    者：葉帆
'**日    期：2004-10-15 13:15:15
'**修 改 人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Sub Clear()
On Error GoTo ToExit '打開錯誤陷阱
'------------------------------------------------
While cltScriptMem.Count > 0
cltScriptMem.Remove (1)
Wend
'------------------------------------------------
Exit Sub
'----------------
ToExit:
Resume Next
End Sub           

功能示範：

1、參數傳遞（單擊【傳遞參數示範】按鈕，自動添加相應腳本代碼。可以執行加減乘除等操作。

下圖示範了錯誤捕捉（被0除錯誤）

2、對象操作（單擊【對象操作示範】按鈕，自動添加相應腳本代碼。可以執行控件的指派和背景色變化操作。