VB6 ActiveX对象的多个实例

Question

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

我开发了一个测试应用程序，我认为这反映了我需要做的事情。首先，模拟下载过程的ActiveX EXE称为TClass。此ActiveX EXE引发事件以报告其当前进度：

TClass.exe（ActiveX EXE，Instancing = SingleUse，Threading Model =每个对象的线程数）

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（）......仍然没有做我想做的事情......

Answer 1

既然你做了一个很好的问题，让你很容易设置一切，我花了一点时间搞砸了这个问题。首先，你的DLL和EXE工作正常。您的问题是您的处理屏幕更新的定时器解决方案已经让您失去了兔子洞。

首先，除非启用了计时器，否则Timer事件永远不会触发，因此检查事件处理程序中的Enabled属性是没用的。接下来，当您调用DoEvents时，它只会刷新当前对象的事件队列。因此，在MYF87_Progress中调用DoEvents不会运行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发布更改时，都不会继续更新文本框。要做到这一点，您需要输入该事件逻辑。我已经把它留给你，因为你似乎已经知道如何去做了。

假设您已完成所有操作，并在遇到问题时回复。

页。秒。创建一个控件数组，只需使数组中的所有控件具有相同的名称，并将Index属性设置为0,1,2,3等。

页。页。秒。我忘了你不能把WithEvents放在一个对象数组中。我要弄乱这个，看看是否有办法让对象进入数组，但是现在可能需要有单独的变量。