Multithreading 当使用多线程时，Mutex将冻结整个应用程序

我有一个vb6多线程应用程序，我想使用互斥来保护数据。预期的行为是，当线程试图在现有互斥体上获取锁时，当调用“WaitForSingleObject”函数时，该线程将阻塞，直到发出互斥体的信号。我所经历的是整个应用程序冻结

要复制我的项目，请打开VB6并创建一个新的活动X EXE。创建具有默认名称的模块。将此代码放入其中：

Option Explicit

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Sub Main()
    ' this hack is necessary to ensure that we only 'create' the application window once..
    Dim hwnd As Long
    hwnd = FindWindow(vbNullString, "Form1")
    If hwnd = 0 Then
        Dim f As Form1
        Set f = New Form1
        f.Show
        Set f = Nothing
    End If
End Sub

接下来，使用默认名称创建一个类，并将以下代码添加到该类中：

Option Explicit

Private Const INFINITE = -1&
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const SYNCHRONIZE As Long = &H100000
Private Const MUTANT_QUERY_STATE As Long = &H1
Private Const MUTANT_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or MUTANT_QUERY_STATE)

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (lpMutexAttributes As Any, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
Private Declare Function OpenMutex Lib "kernel32" Alias "OpenMutexA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long) As Long

Private Const MUTEX_NAME As String = "mymutex"
Private m_hCurrentMutex As Long

Public Sub Class_Terminate()
    Call ReleaseIt
End Sub

Public Sub LockIt(success As String)
    Dim hMutex          As Long

    MsgBox "Lockit t:" & App.ThreadID
    hMutex = OpenMutex(STANDARD_RIGHTS_REQUIRED, 0, MUTEX_NAME)
    If hMutex <> 0 Then
        Form1.Caption = "waiting on mutex"
        MsgBox "waiting t:" & App.ThreadID
        Dim res As Long
        Do
            'MsgWaitForMultipleObjects
            res = WaitForSingleObject(hMutex, INFINITE)
            DoEvents
        Loop While res = -1
        m_hCurrentMutex = hMutex
    Else
        Form1.Caption = "creating mutex"
        m_hCurrentMutex = CreateMutex(ByVal 0&, 1, MUTEX_NAME)
    End If
    Form1.Caption = success
    MsgBox success
End Sub

Public Sub ReleaseIt()
    If m_hCurrentMutex <> 0 Then
        Call ReleaseMutex(m_hCurrentMutex)
        Call CloseHandle(m_hCurrentMutex)
        m_hCurrentMutex = 0
    End If
End Sub

前两个命令按钮锁定各自的互斥锁。第二个两个释放它。请注意，在锁定互斥锁之前，将显示一个唯一的线程id。这让我相信只有线程应该阻塞，而不是冻结整个应用程序

如蒙协助，将不胜感激。多谢各位

---

编辑：我忘了提到一个非常重要的部分：在“项目属性”部分，我将其设置为创建“每个对象的线程”，并通过msghox App.ThreadID调用的结果进行验证。

为了避免锁定应用程序，至少在调用CreateThread时，您应该在应用程序中的某个位置创建应用程序

问题是，您所有的代码都在一个线程上执行，即主应用程序线程。因此，当您单击该按钮时，主线程将阻塞WaitForSingleObject，直到释放互斥对象。由于主线程被阻止，应用程序的UI冻结（消息循环被阻止），因此您无法单击其他按钮来释放互斥

---

编辑：即使每个对象都有自己的线程，对类方法的调用似乎是同步的。这意味着调用线程（在您的例子中是UI线程）将等待LockIt方法结束，即使LockIt方法中的代码在另一个线程中执行。您可以通过在

Command1\u Click

和

Command2\u Click

的末尾放置一个消息框来轻松检查这一点。这些消息框将仅在显示LockIt中的所有消息框后显示，而不是在调用LockIt方法后立即显示。（我认为最好用保存到文件中的某种日志消息替换MessageBox）。总之，线程同步似乎是一种默认行为，因此可能不需要使用互斥体。

虽然可以让一个类创建另一个线程（使用），但仍然有一个执行线程，即所有调用都是序列化的

---

如果希望跨线程进行异步调用，则需要在该函数中设置计时器（

SetTimer（）

API），并在执行长时间运行的代码之前等待回调。还要注意的是，当线程被锁定时，你不能对它进行任何调用，除非它们可以中断并调用

DoEvents

啊-我忘了提到一个非常重要的部分：在项目属性部分，我将其设置为创建“每个对象的线程”，这通过msghox App.ThreadID调用的结果进行验证。关于使用相同的互斥体名称，这是必要的，因为我需要保护各种变量。在这个演示应用程序中，实际上没有任何东西受到保护，但在应用程序中，我使用互斥体名称作为共享变量/内存的名称，这样即使我使用了互斥体，它也不会冻结另一个线程的互斥体——只要它是不同的互斥体。@AuthmanApatira您能解释一下应用程序何时会阻止吗（我没有安装VB6）。我将单击第一个锁定按钮，然后向我发送线程id、等待，然后是我传入的字符串（object0）提醒我它已成功获取互斥锁。当我单击第二个锁定按钮时，它会向我发送一个不同的、唯一的线程id，等待，然后游戏结束。如果我注释掉dowhile循环并离开waitforsingleobject行，它会返回-1（失败）并立即继续处理该函数。因此doevents实际上没有帮助/做任何事情。我在想，因为这是一个新线程，可能它需要处理Windows MSG，因此是msgwait行，但是iono@bosonix：有关所用方法的说明，请参阅。

Option Explicit
Dim c(1) As Class1

'Lock
Private Sub Command1_Click()
    If c(0) Is Nothing Then Set c(0) = CreateObject("Project1.Class1")
    Call c(0).LockIt("Object0")
End Sub
Private Sub Command2_Click()
    If c(1) Is Nothing Then Set c(1) = CreateObject("Project1.Class1")
    Call c(1).LockIt("Object1")
End Sub


'Free
Private Sub Command3_Click()
    If c(0) Is Nothing Then Set c(0) = CreateObject("Project1.Class1")
    Call c(0).ReleaseIt
End Sub
Private Sub Command4_Click()
    If c(1) Is Nothing Then Set c(1) = CreateObject("Project1.Class1")
    Call c(1).ReleaseIt
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Set c(0) = Nothing
    Set c(1) = Nothing
    End
End Sub