multithreading - VB6 ActiveX 对象的多个实例

标签 multithreading vb6 activex activex-exe

在 VB6 中(由于客户端要求),我需要能够执行我编写的 ActiveX EXE 的多个实例,以通过 RS232 将文件下载到多个单元。

我开发了一个测试应用程序,我认为它反射(reflect)了我需要做的事情。首先是一个模拟下载过程的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 中的公共(public)属性更新 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() ......仍然没有做我想做的事情......

最佳答案

由于您在提出问题方面做得很好,使设置一切变得非常容易,所以我花了一点时间在这个问题上胡闹。首先,您的 DLL 和 EXE 工作正常。您的问题是您处理屏幕更新的计时器解决方案已使您陷入困境。

首先,除非启用计时器,否则 Timer 事件永远不会触发,因此检查事件处理程序中的 Enabled 属性是没有用的。接下来,当您调用 DoEvents 时,它只会刷新当前对象的事件队列。因此,在 MYF87_Progress 中调用 DoEvents 不会运行您的 Timer 事件。所以 Timer 事件不触发是不正确的;发生的事情是,您的所有 Timer 事件都堆积在表单的事件队列中,并且在 DLL 执行完成时它们都会立即执行。正如您所发现的那样,这种设计不起作用,即使您找到修复它的方法,您也会得到类似于 Jed Clampett 的卡车的东西。

更好的设计是将 Progress 事件也添加到您的 DLL 中,从您的 MYF87_Progress 处理程序中引发它,并让您的表单处理它。 (我假设你的包装 DLL 的原因是你有更多的东西可以放入其中,应该只放在一个地方,否则我建议你通过让你的表单直接调用 EXE 来简化你的设计。)在表单处理程序中调用 DoEvents 以更新屏幕。

接下来,这个实现需要控制数组。您可以将每个命令按钮、五个文本框的每个集合以及每个 DLL 实例放在一个数组中。这将大大简化您必须做的工作。事实上,您的整个表单代码几乎可以简化为这个(加上我提到的事件处理程序):

Option Explicit

Private lc(4) As WClass.WrapperClass

Private Sub cmd_Click(Index As Integer)
    Set lc(Index) = CreateObject("WClass.WrapperClass")
    With lc(Index)
        .WSeedVal = CInt(txt(Index).Text)
        .Go
        txtRes(Index).Text = CStr(.WResultVal)
    End With
End Sub

此代码将在您每次按下按钮时显示最终结果,但不会在每次从您的 EXE 发布更改时更新您的文本框。为此,您需要输入该事件逻辑。我将把它留给你,因为你似乎已经知道如何去做了。

假设您尝试了所有这些,如果遇到问题,请回帖。

页。 s。要制作一个控件数组,只需使数组中的所有控件都具有相同的名称,并将 Index 属性设置为 0、1、2、3 等。

页。页。 s。我忘了你不能把 WithEvents 和对象数组放在一起。我要搞砸这个,看看是否有办法将对象放入数组中,但可能需要像现在一样拥有单独的变量。

关于multithreading - VB6 ActiveX 对象的多个实例,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/28178870/

相关文章:

c# - 快速创建数千个线程并同时执行它们

c# - 将旧的 VB6 QBColor 函数翻译成 C#

c# - Mstsc ActiveX 控件警告

vba - 引用ActiveX控件: Run-time Error 438时,VBA错误处理程序的 “For Each __ in __”失败

c++ - 如何使用 IGlobalInterfaceTable 传递接口(interface)指针?

javascript - 为什么 node.js 是异步的?

c++ - 按执行顺序创建pthread

datetime - 一个更好的 VB6 CDate

file - VB6 生成编号列表

excel - 在 Visual Basic 6.0 中使用 Microsoft (Office) 365 工具