在 VB6 中(由于客户端要求),我需要能够执行我编写的 ActiveX EXE 的多个实例,以通过 RS232 将文件下载到多个单元。
我开发了一个测试应用程序,我认为它反映了我需要做的事情。首先是一个模拟下载过程的ActiveX EXE,称为TClass。此 ActiveX EXE 引发事件以报告其当前进度,如下所示:
TClass.exe (ActiveX EXE, Instancing = SingleUse, Threading Model = Thread per Object)
Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Public Event Progress(Value As Long)
Public SeedVal As Long
Public Sub MultByTwo()
Dim i As Integer
Dim lVal As Long
lVal = SeedVal
For i = 0 To 10
Sleep (2000)
lVal = lVal * 2
RaiseEvent Progress(lVal)
Next i
Exit Sub
End Sub
接下来是一个包装类来实例化 TClass 并处理回调事件(Progress),称之为 WClass(AxtiveX DLL,Instancing = MultiUse,Apartment Threaded):
Option Explicit
Public WSeedVal As Long
Public WResultVal As Long
Private WithEvents MYF87 As TClass.TargetClass
Private Sub Class_Initialize()
' Set MYF87 = CreateObject("TClass.TargetClass")
Set MYF87 = New TClass.TargetClass
End Sub
Public Function Go() As Integer
MYF87.SeedVal = WSeedVal
MYF87.MultByTwo
End Function
Public Sub MYF87_Progress(Value As Long)
WResultVal = Value
DoEvents
End Sub
Public Function CloseUpShop() As Integer
Set MYF87 = Nothing
End Function
最后是用于实例化 WClass 的 UI。这是一个简单的表单应用程序:
Option Explicit
Private lc1 As WClass.WrapperClass
Private lc2 As WClass.WrapperClass
Private lc3 As WClass.WrapperClass
Private lc4 As WClass.WrapperClass
Private lc5 As WClass.WrapperClass
Private Sub cmd1_Click()
Set lc1 = CreateObject("WClass.WrapperClass")
lc1.WSeedVal = CInt(txt1.Text)
lc1.Go
End Sub
Private Sub cmd2_Click()
Set lc2 = CreateObject("WClass.WrapperClass")
lc2.WSeedVal = CInt(txt2.Text)
lc2.Go
End Sub
Private Sub cmd3_Click()
Set lc3 = CreateObject("WClass.WrapperClass")
lc3.WSeedVal = CInt(txt3.Text)
lc3.Go
End Sub
Private Sub cmd4_Click()
Set lc4 = CreateObject("WClass.WrapperClass")
lc4.WSeedVal = CInt(txt4.Text)
lc4.Go
End Sub
Private Sub cmd5_Click()
Set lc5 = CreateObject("WClass.WrapperClass")
lc5.WSeedVal = CInt(txt5.Text)
lc5.Go
End Sub
Private Sub Form_Load()
Timer1.Interval = 2000
Timer1.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Not lc1 Is Nothing Then
lc1.CloseUpShop
Set lc1 = Nothing
End If
If Not lc2 Is Nothing Then
lc2.CloseUpShop
Set lc2 = Nothing
End If
If Not lc3 Is Nothing Then
lc3.CloseUpShop
Set lc3 = Nothing
End If
If Not lc4 Is Nothing Then
lc4.CloseUpShop
Set lc4 = Nothing
End If
If Not lc5 Is Nothing Then
lc5.CloseUpShop
Set lc5 = Nothing
End If
End Sub
Private Sub Timer1_Timer()
If Timer1.Enabled Then
Timer1.Enabled = False
If Not lc1 Is Nothing Then
txtRes1.Text = CStr(lc1.WResultVal)
txtRes1.Refresh
End If
If Not lc2 Is Nothing Then
txtRes2.Text = CStr(lc2.WResultVal)
txtRes2.Refresh
End If
If Not lc3 Is Nothing Then
txtRes3.Text = CStr(lc3.WResultVal)
txtRes3.Refresh
End If
If Not lc4 Is Nothing Then
txtRes4.Text = CStr(lc4.WResultVal)
txtRes4.Refresh
End If
If Not lc5 Is Nothing Then
txtRes5.Text = CStr(lc5.WResultVal)
txtRes5.Refresh
End If
Timer1.Interval = 2000
Timer1.Enabled = True
End If
DoEvents
End Sub
txt1、txt2、txt3、txt4 和 txt5 是提供种子值的文本项,该种子值最终作为属性传递给 TClass。txtRes1、txtRes2、txtRes3、txtRes4 和 txtRes5 是保存 TClass.MultByTwo 结果的文本项,通过 RaiseEvent Progress() 调用报告。cmd1、cmd2、cmd3、cmd4 和 cmd5 与上面对应的 _Click 函数相关联,并实例化 WClass.WrapperClass 并让一切顺利进行。该表单还有一个名为 Timer1 的 Timer 对象,设置为每 2 秒触发一次。这样做的唯一目的是从 WClass 中的公共属性更新 UI。
我已将 TClass 构建为 TClass.exe,将 WClass 构建为 WClass.dll,并从 UI 应用程序中引用了 WClass.dll。当我运行表单并单击 cmd1 时,我注意到的第一件事是 Timer1_Timer 不再触发,因此我的 UI 永远不会更新。其次,如果我单击 cmd2,它会触发,但似乎会阻止第一个实例的执行。
我花了几天时间阅读 MSDN 上的帖子和说明……不走运……任何帮助将不胜感激!
谢谢!
更新:我已更改 WClass.dll 包装类以实现使用回调函数的建议。见下文:
V2: WClass.dll (ActiveX DLL, Apartment Threading, Instancing = MultiUse)
Option Explicit
Public WSeedVal As Long
Public WResultVal As Long
Public Event WProgress(WResultVal As Long)
Private WithEvents MyTimer As TimerLib.TimerEx
Private WithEvents MYF87 As TClass.TargetClass
Private gInterval As IntervalData
Private Sub Class_Initialize()
Set MyTimer = CreateObject("TimerLib.TimerEx")
' Set MyTimer = New TimerLib.TimerEx
Set MYF87 = CreateObject("TClass.TargetClass")
' Set MYF87 = New TClass.TargetClass
End Sub
Public Function Go() As Integer
gInterval.Second = 1
MyTimer.IntervalInfo = gInterval
MyTimer.Enabled = True
End Function
Private Sub MyTimer_OnTimer()
MyTimer.Enabled = False
MYF87.SeedVal = WSeedVal
MYF87.MultByTwo
End Sub
Public Sub MYF87_Progress(Value As Long)
WResultVal = Value
RaiseEvent WProgress(WResultVal)
DoEvents
End Sub
Public Function CloseUpShop() As Integer
Set MYF87 = Nothing
End Function
UI 类的必要更改:
Option Explicit
Private WithEvents lc1 As WClass.WrapperClass
Private WithEvents lc2 As WClass.WrapperClass
Private WithEvents lc3 As WClass.WrapperClass
Private WithEvents lc4 As WClass.WrapperClass
Private WithEvents lc5 As WClass.WrapperClass
Private Sub cmd1_Click()
' MsgBox ("Begin UI1.cmd1_Click")
Set lc1 = CreateObject("WClass.WrapperClass")
lc1.WSeedVal = CInt(txt1.Text)
lc1.Go
' MsgBox ("End UI1.cmd1_Click")
End Sub
Public Sub lc1_WProgress(WResultVal As Long)
txtRes1.Text = CStr(WResultVal)
txtRes1.Refresh
DoEvents
End Sub
Private Sub cmd2_Click()
Set lc2 = CreateObject("WClass.WrapperClass")
lc2.WSeedVal = CInt(txt2.Text)
lc2.Go
End Sub
Public Sub lc2_WProgress(WResultVal As Long)
txtRes2.Text = CStr(WResultVal)
txtRes2.Refresh
DoEvents
End Sub
Private Sub cmd3_Click()
Set lc3 = CreateObject("WClass.WrapperClass")
lc3.WSeedVal = CInt(txt3.Text)
lc3.Go
End Sub
Public Sub lc3_WProgress(WResultVal As Long)
txtRes3.Text = CStr(WResultVal)
txtRes3.Refresh
DoEvents
End Sub
Private Sub cmd4_Click()
Set lc4 = CreateObject("WClass.WrapperClass")
lc4.WSeedVal = CInt(txt4.Text)
lc4.Go
End Sub
Public Sub lc4_WProgress(WResultVal As Long)
txtRes4.Text = CStr(WResultVal)
txtRes4.Refresh
DoEvents
End Sub
Private Sub cmd5_Click()
Set lc5 = CreateObject("WClass.WrapperClass")
lc5.WSeedVal = CInt(txt5.Text)
lc5.Go
End Sub
Public Sub lc5_WProgress(WResultVal As Long)
txtRes5.Text = CStr(WResultVal)
txtRes5.Refresh
DoEvents
End Sub
Private Sub Form_Load()
' Timer1.Interval = 2000
' Timer1.Enabled = True
Timer1.Enabled = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Not lc1 Is Nothing Then
lc1.CloseUpShop
Set lc1 = Nothing
End If
If Not lc2 Is Nothing Then
lc2.CloseUpShop
Set lc2 = Nothing
End If
If Not lc3 Is Nothing Then
lc3.CloseUpShop
Set lc3 = Nothing
End If
If Not lc4 Is Nothing Then
lc4.CloseUpShop
Set lc4 = Nothing
End If
If Not lc5 Is Nothing Then
lc5.CloseUpShop
Set lc5 = Nothing
End If
End Sub
我仍然看到相同的行为...单击 cmd1,然后我看到结果从 txtRes1 开始。点击cmd2,txtRes1中的结果停止更新,txtRes2更新直到完成,然后txtRes1更新。
我不希望它在 VB6 调试器中工作,因为它是单线程的,但是创建一个可执行文件并运行该可执行文件仍然会产生相同的结果。
我也尝试过改变我的 TClass 的实例化方式(New 与 CreateObject)——没有发现任何区别。我也尝试过在实例化 WClass 时使用 New 和 CreateObject() ......仍然没有做我想做的事情......