VBScript脚本运用(脚本程序与宿主程序的交互)

简介: 做过工控的人都知道,对脚本语言的支持是标准组态软件应具备的一个基本功能(如iFix,组态王等)。如果我们用VB开发类似的功能,能实现吗

做过工控的人都知道,对脚本语言的支持是标准组态软件应具备的一个基本功能(如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、对象操作(单击【对象操作演示】按钮,自动添加相应脚本代码。可以执行控件的赋值和背景色变化操作。

相关文章
|
搜索推荐 JavaScript Java
计算机毕业设计 图书管理系统 Vue+SpringBoot+MySQL(一)
计算机毕业设计 图书管理系统 Vue+SpringBoot+MySQL
727 2
|
机器学习/深度学习 人工智能 负载均衡
基于 NVIDIA Megatron-Core 的 MoE LLM 实现和训练优化
本文将分享阿里云人工智能平台 PAI 团队与 NVIDIA Megatron-Core 团队在 MoE (Mixture of Experts) 大型语言模型(LLM)实现与训练优化上的创新工作。
|
11月前
|
存储 Java 编译器
说一说关于序列化/反序列化中的细节问题
我是小假 期待与你的下一次相遇 ~
224 1
|
NoSQL Java Redis
【📕分布式锁通关指南 06】源码剖析redisson可重入锁之加锁
本文详细解析了Redisson可重入锁的加锁流程。首先从`RLock.lock()`方法入手,通过获取当前线程ID并调用`tryAcquire`尝试加锁。若加锁失败,则订阅锁释放通知并循环重试。核心逻辑由Lua脚本实现:检查锁是否存在,若不存在则创建并设置重入次数为1;若存在且为当前线程持有,则重入次数+1。否则返回锁的剩余过期时间。此过程展示了Redisson高效、可靠的分布式锁机制。
472 0
【📕分布式锁通关指南 06】源码剖析redisson可重入锁之加锁
|
缓存 前端开发 JavaScript
PWA实战:从零构建高性能渐进式应用
【7月更文第28天】渐进式Web应用(PWA)是一种使用现代Web技术构建的应用程序,它具有原生应用程序的功能,例如离线访问、推送通知和安装到主屏幕的能力。本文将引导您从零开始构建一个高性能的PWA,并涵盖关键技术点,如Service Workers、缓存策略、离线支持和性能优化。
870 3
|
机器学习/深度学习 数据采集 存储
使用Python实现智能农业灌溉系统的深度学习模型
使用Python实现智能农业灌溉系统的深度学习模型
985 6
|
数据采集 人工智能 文字识别
【AAAI 2024】MuLTI:高效视频与语言理解
多模态理解模型具有广泛的应用,比如多标签分类、视频问答(videoQA)和文本视频检索等。现有的方法已经在视频和语言理解方面取得了重大进展,然而,他们仍然面临两个巨大的挑战:无法充分的利用现有的特征;训练时巨大的GPU内存消耗。我们提出了MuLTI,这是一种高度准确高效的视频和语言理解模型,可以实现高效有效的特征融合和对下游任务的快速适应。本文详细介绍基于MuLTI实现高效视频与语言理解。
|
前端开发 异构计算 API
探索Stable Diffusion:从零开始的代码接入创意图像生成指南
探索Stable Diffusion,了解这一图像生成技术,适用于创意设计、内容生成和前端应用。本文从基本概念到实战,教你如何用Python和相关库搭建环境,通过GPU加速,生成基于文本提示的图像。学习多样性和风格融合技巧,解决实践中遇到的问题,如内存溢出和图像模糊。前端开发者可将模型部署为API,实现实时动态图像生成,提升用户体验。一起发掘Stable Diffusion在艺术和设计领域的无限潜力!
943 2
费德勒权变模型(Fiedler Contingency Model)详解与Python代码示例
费德勒权变模型(Fiedler Contingency Model)详解与Python代码示例
|
SQL Java 数据库连接
jpa、hibernate、spring-data-jpa、jdbcTemplate
jpa、hibernate、spring-data-jpa、jdbcTemplate
341 1