Excel中多线程的新方法

 doInstruction 

 clsHandleEvents 

 interface 

 IWorkerEvents 

 clsMultiThread 

 worker 

 Option Explicit

'''
'This class creates and runs a new multithread instance which runs clsHtmlWorker
'When each HTMLDocument is complete, the class scans it for e-mails
'''
Private WithEvents multiThreadGroup As clsMultiThread
'clsMultiThread is async so must be  declared separately (or in a doEvents loop)
Private Const REGEX_PATTERN As String = _
"(?:[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*|""(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21\x23-\x5b\x5d-\x7f]|\[\x01-\x09\x0b\x0c\x0e-\x7f])*"")@(?:(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?|\[(?:(?:(2(5[0-5]|[0-4])|1[0-9]|[0-9]?[0-9]))\.){3}(?:(2(5[1-9]|[0-9])|1[0-5]|[0-4]?[0-9])|[0-9]*[0-9]:(?:[1-9]|\[0-9])+)\])"

Public Sub run()
    'urls to check for emails are in a1:a10
    htmlRequestToUrls [a1:a10]
End Sub

Private Sub htmlRequestToUrls(urlCells As Range)

    Set multiThreadGroup = New clsMultiThread
    With multiThreadGroup
        .Size = urlCells                         'set iterable, here a load of urls
        Set .AsyncClass = New clsHtmlWorker      'set async worker
        .Execute                                 'run the group
    End With

End Sub

Private Sub multiThreadGroup_TaskComplete(returnVal As Variant, taskID As String, threadID As String)

    Dim rowI As Long, colI As Long
    rowI = Right(taskID, Len(taskID) - 4)

    If returnVal Is Nothing Then
        Cells(rowI, 2) = "Error in loading page"
    ElseIf TypeOf returnVal Is HTMLDocument Then
        Dim emailMatches() As String
        emailMatches = regexMatches(returnVal.body.innerText)
        If (Not emailMatches) = -1 Then
        'no emails on page
            Cells(rowI, 2) = "No e-mail matches"
        Else
            For colI = LBound(emailMatches) To UBound(emailMatches)
                Cells(rowI, colI + 2) = emailMatches(colI)
            Next colI
        End If
    Else                                         'nothing returned
        Cells(rowI, 2) = "Error in loading page"
    End If


End Sub

Private Function regexMatches(strInput As String) As String()

    Dim rMatch As Object
    Dim s As String
    Dim arrayMatches() As String
    Dim i As Long

    With CreateObject("VBScript.Regexp")
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = REGEX_PATTERN
        If .test(strInput) Then
            For Each rMatch In .Execute(strInput)
                ReDim Preserve arrayMatches(i)
                arrayMatches(i) = rMatch.value
                i = i + 1
            Next
        End If
    End With

    regexMatches = arrayMatches

End Function
 

#1 楼

有趣的想法，做得好！

命名

我真的不喜欢这个名字。像clsMultiThread这样的名称在某种程度上具有误导性，因为如您所述，它们实际上并未提供任何真正的多线程。一个粗心的用户会期望它可以处理任何事情，并且当他们所有排队的工作痛苦地同步完成时，他们会感到失望。 ;）

此外，我们并不是真正在使用线程，而是可能在进程内运行或可能不在进程内运行的对象。您使用了MSXML2.XMLHTTP60，因此它应该在进程中运行。但是，如果我们使用类似ShDocVw.WebBrowser甚至Excel.Application之类的东西可能会导致进程外运行，则不一定如此。那不是线程。因此，在那种情况下，我们实际上是在谈论异步运行，而不是线程运行。关键是它应该传达这样的观念，即那些对象与异步运行无关。我们只是在安排异步任务以并行运行。

您在评论中询问了匈牙利符号。我个人的喜好是不要对对象使用匈牙利表示法，因此我不会使用ParallelTaskCoordinator前缀。是否添加前缀不会帮助解决有关名称空间的问题，这主要是因为良好的名称空间与逻辑分组有关，而不是根据模块的类型将它们组合在一起。我可以将HN用于私有变量，而不是使用面向公共的属性（例如模块的名称，公共属性），因为它们只是分散了它们的语义含义。名称的语义部分更为重要，良好的命名约定应支持该名称。

通常，您的命名方案似乎经过深思熟虑。我确实看到的不一致之处是，在TaskHandle方法中，您将AsyncObjectWatcher作为参数名称，然后将其分配给cls。为什么不以相同的方式调用参数，所以在编写Execute方法时应该清楚它应该是什么？

不是完全异步的，可能被主线程阻止了。

它可以独立工作。但是，我确实想提醒您注意以下事实：它在更复杂的场景中不起作用。这是一个中断的示例：

在立即窗口中执行：

任务进度。在实践中，我始终要完成5个任务，然后输出100个delegate，然后再完成其他5个任务。这告诉我，如果在其他线程中的任务正在运行时允许主线程执行操作，则这些任务将被阻塞，直到主线程变为空闲状态为止。因此，如果不小心，很容易破坏异步。

如您所见，即使撒上eventHandle显然也不足够。考虑一下，这并不奇怪，因为“事件”来自必须在UI线程中运行的同一VBA代码。因此，如果这成为问题，则必须将异步完全委派给外部进程/线程（例如，通过外部库），在该进程/线程中您可以通过事件将进度传达给VBA代码，而不是依赖于外部对象将事件引发为工作者，必须向线程句柄然后向管理器引发事件。

请注意，即使走了这条路线，您也需要具有重试逻辑才能成功引发事件，因为运行VBA代码可能会阻止进入。有机会错过一个事件，尤其是在活动率很高且投入过多的情况下。在这里，这里，这里之前已经观察到了这一点。这些示例说明了某些情况并非总是以我们期望的方式触发的情况。

如注释中所建议，更改最大线程数可能会更好。例如，将最大线程数设置为2，我们看到任务1和任务2在阻塞之前完成了90次打印Execute，然后允许任务3开始然后完成，然后再阻塞10次以上，并且休息完成。但是，这在我的系统上非常一致。在运行测试的3次中，任务3直到打印90才开始，其余的直到100打印才开始。另一方面，如果将maxthreads设置为1，则会完成一个任务，然后在允许其余任务运行之前被阻塞100次。我不希望它容易复制，因为这会受到许多因素（硬件，Windows版本，Excel版本）的影响。这只是要注意的事情，并针对这种可能性进行明确设计。

如果对您来说至关重要的是，不要被阻止，则需要考虑采用其他方法。例如，您需要一个外部.NET库来创建线程，运行任务，然后将输出写入文件。这使主线程可以随意读取它，并且当主线程需要执行某些操作时，不会自动阻塞任何生成的线程。即便如此，它仍然受到以下事实的影响：尝试生成新线程时，它可能会被阻止（因为您需要VBA来运行代码来创建一个新线程，即使它只是在DLL中调用外部函数也是如此）。 >
注意：在我所有的测试中，仅打印的Debug.Print i是i和DoEvents和i。我已经把Debug.Print注释掉了；否则，立即窗口将溢出，并且从头到尾都看不到所有输出。

WinHttp而不是MSXML

此外，我想引起您的注意的是，您可能拥有一个Task N started实例，该实例本身就支持事件。因此，您可以声明类似Task N completed的变量，而不是监听事件。这意味着您不需要像使用Events terminated那样设置默认成员，并且如果您只是执行Internet请求，那么您甚至不需要线程集合。只需收集PrintState并收听他们的事件。

但这显然不是通用的解决方案，并且在需要工人处理设置的情况下，使用WinHttp.WinHttpRequest并不妨碍我们将其与上述解决方案一起使用。

如果不需要，请不要递归

您有一个Private WithEvents request As WinHttp.WinHttpRequest，它可以递归调用自己。但是IMPOV，没有理由进行递归。您可以通过一个简单的循环来完成相同的操作，就像我的hacky更改所展示的那样。一个更合适的解决方案可能是在循环的底部使用多个条件或一个标志变量（确保它至少执行一次）。这样就可以确保您不必担心堆栈溢出。 ：

call runtest: for i = 0 to 100 : debug.Print i: doevents: next

我的印象是管理器的目的是允许我们为每个异步运行的工人创建线程。因此，我只能使用MSXML来设置WinHttp.WinHttpRequest的单个实现，这似乎很奇怪。我是否应该能够分配一群工人，然后征集他们自己的论点？我认为这将是更直观地使用管理器。像这样的东西：

Private Sub doInstructions(Optional freeThreadID As String, Optional loopcount As Long = 1)
    Dim instructionVal As Instruction

Do
    'mark thread free if applicable
    If freeThreadID <> vbNullString Then freeThread = freeThreadID

    'find out what to do
    instructionVal = getInstruction()
    'carry out instruction
    Select Case instructionVal.instructionBody
    Case InstructionType.mltCloseThread
        closeThread instructionVal.threadID
    Case InstructionType.mltOpenThread
        openThread
    Case InstructionType.mltSetTask
        Dim taskThread As clsThreadHandle
        Dim taskArguments As Variant
        Set taskThread = threadGroup(instructionVal.threadID)
        'assign task to thread
        assignTaskID (taskThread.Name)
        'get any arguments there may be
        'mark thread as busy

        BusyThread = taskThread.Name
        'iterate open tasks
        openTaskCount = openTaskCount + 1
        'execute task
        If passesArguments Then
            'pop appropriate item from queue
            Set taskArguments = iterableQueue.Dequeue
            taskThread.Execute taskArguments
        Else
            taskThread.Execute
        End If

    Case InstructionType.mltQuit
        'quit then do nothing
        Me.Quit
        instructionVal.instructionBody = mltDoNothing
    Case InstructionType.mltDoNothing
        'do nothing
    Case Else
        Err.Raise 5                              'invalid argument
    End Select

    'call self until no instruction
    If instructionVal.instructionBody <> mltDoNothing Then
Debug.Assert loopcount < maxThreads * 3 + 5      'max loop should be open all threads then run all tasks + a little
        'doInstructions loopcount:=loopcount + 1  'watch for infinite loop
        freeThreadID = vbNullString
        loopcount = loopcount + 1
    Else
        Exit Do
    End If
Loop

End Sub

由此可见，通过传入WinHttp.WinHttpRequest工厂，显然可以看到要设置要执行的任务。这不会将我们限制为仅一个特定的工作者类，它有助于查看我们为每个任务发送的参数。

将您的私有字段封装为一种类型建议您从@MathieuGuindon的书中取出一页，并使用他的方法：区分类的私有后备字段和公开的属性。这是帮助错误代码看起来错误的一种方法。

Initialize事件中的RaiseEvents

在我看来这可能很麻烦： >
对于doInstructions和AsyncClass事件内部的任何工作，我个人的规则是使代码与类完全隔离。通常，不适合在课堂外伸出手，因为它尚未完成自身的构建，因此，结果可能无法预测。在这种情况下，效果可能是良性的，因为我们仅引发带有报告参数的事件。但是，在更复杂的实现中，这可能会以意外的方式起作用。此外，它实际上并没有买任何东西，因为如果调用IWorker，我们就已经知道了，因为通常我们首先必须对其进行初始化。

您真的需要一个队列吗？

使用.NET队列来帮助设置参数很酷。但是，这意味着您有一个额外的参考，并且您已经有许多参考，这使得很难将代码分发到不同的环境。

一种方法是延迟绑定队列，方法是将其声明为对象并执行IWorker。这样一来，您就无需添加对.NET核心库的显式引用，从而无需了解.NET Framework版本，因为在这种情况下，该类在版本之间不会更改。另一种选择是只使用内置的VBA集合。 IINM，您仅使用队列来收集参数，VBA选择也可以做到这一点。这会给您类似队列的行为：

Set .AsyncClass = New clsHtmlWorker

，没有任何外部引用。 >
@Raystafarian提到，实现接口时，您不应该接受默认的this.命名。我个人讨厌，并且总是更改名称。接口的实现并不关心您使用的名称。它唯一关心的是有一个名为something的过程（检查），它具有N个参数（检查），并且每个参数都具有相同的数据类型（检查）。它甚至不查看参数的名称。因此，您应该将它们更改为更明智的设置。如果您不敢想象，请给他们打电话Initialize，这是我通常要做的。只是不要将其保留为RHS。

#2 楼

这超出了我的专业知识，但也许添加答案会导致更多的浏览/答案？另外，那个初学者标签在做什么？ ;）
首先，我要说的真的很扎实。这可能就是为什么这里没有太多活动的原因。

ByRef或ByVal参数
您可能知道的每个参数中，未声明ByVal是隐式地ByRef。我想您可能需要其中许多作为ByRef，但最好将它们明确声明为ByRef，这样更容易分辨它应该是ByRef。给定它们都是相同的类型，三个可能会使用一个新名称。也许是threadObject或threadHandle-由您决定。
第四个是采用变体并返回布尔值，它的名称可以是testObject到iteratorGroup。您可能想重命名其中的一些
队列我怎么知道queue是什么以及使用什么方法？它不是VBA的标准参考库，是吗？我可能会在其中添加评论，解释您为什么选择以这种方式进行操作，因此没有人需要回顾所有内容以弄清楚为什么它比其他方法更好。
RHS？
clsHtmlWorker

clsHandleEvents.Complete(obj as clsThreadHandle)
clsHandleEvents.NotifyComplete(obj as clsThreadHandle)
clsMultiThread.threadEvents_Complete(obj as clsThreadHandle)
multiThreadMethods.isIterable(obj as Variant)

什么是RHS？它是一个常数吗？我可以告诉您，在您的项目中使用Html而不是HTML更好-那是什么呢？

所有这些，我什至无法真正弄清楚它的工作原理，我看到了应该将请求发送到哪里（httpRequest），但是我无法弄清楚它们是如何返回并填充工作表的，我看不到发生了什么，我认为这是异步的吗？