VB6多线程,关键段操作

Option Explicit

Declare Function GetLastError Lib "kernel32" () As Long
'Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'Declare Sub ExitThread Lib "kernel32" (Optional ByVal dwExitCode As LOng= 0)
'Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Declare Function CreateThreadL Lib "kernel32" Alias "CreateThread" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Public Const CREATE_SUSPENDED = &H4
Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long

Public 结束所有线程操作 As Boolean
'Public 线程属性 As SECURITY_ATTRIBUTES
Public ID As Long, 句柄1 As Long, 句柄2 As Long, 参数 As Long
Public 共享变量 As Long
Public 线程数量 As Long

Public Declare Sub InitializeCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION)
Public Declare Sub DeleteCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION)
Private Declare Sub EnterCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION)
Private Declare Sub LeaveCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION)
Public Type CRITICAL_SECTION
    DebugInfo As Long
    LockCount As Long
    RecursionCount As Long
    OwningThread As Long
    Reserved As Long
End Type
Public g_cs As CRITICAL_SECTION

Public Sub 创建线程()
    线程数量 = 0
    

    结束所有线程操作 = False
    '线程属性.nLength = Len(线程属性)
    句柄1 = CreateThreadL(0, 0, AddressOf 线程函数1, 0&, CREATE_SUSPENDED, ID)
    句柄2 = CreateThreadL(0, 0, AddressOf 线程函数2, 0&, CREATE_SUSPENDED, ID)
    If 句柄1 <> 0 And 句柄2 <> 0 Then
        主窗体.Caption = "成功！句柄1：" & 句柄1 & "；句柄2：" & 句柄2 & "；ID：" & ID ' & "；参数：" & 参数
    Else
        主窗体.Caption = "失败！错误码：" & GetLastError
    End If
End Sub

Public Sub 启动线程()
    If ResumeThread(句柄1) = -1 Then
        主窗体.Caption = "失败！错误码：" & GetLastError
    End If
    If ResumeThread(句柄2) = -1 Then
        主窗体.Caption = "失败！错误码：" & GetLastError
    End If
End Sub

Public Sub 结束线程()
    Dim EndThread As Boolean
    Call EnterCriticalSection(g_cs)
        结束所有线程操作 = True
    Call LeaveCriticalSection(g_cs)
    Do
        DoEvents '奇怪，不能不加。可能处理全局变量仍然需要主线程的参与吧。
        Call EnterCriticalSection(g_cs)
            EndThread = (线程数量 <= 0)
        Call LeaveCriticalSection(g_cs)
    Loop Until EndThread
End Sub

Public Function 线程函数1(ByVal 参数 As Long) As Long
    Call EnterCriticalSection(g_cs)
        线程数量 = 线程数量 + 1
    Call LeaveCriticalSection(g_cs)
    Dim i As Long
    For i = 0 To 100000
        Call EnterCriticalSection(g_cs)
            If 结束所有线程操作 Then
                Call LeaveCriticalSection(g_cs)
                Exit For
            End If
            主窗体.tr1.Caption = i
            共享变量 = 共享变量 + 1
            主窗体.tr.Caption = 共享变量
        Call LeaveCriticalSection(g_cs)
    Next
    Call EnterCriticalSection(g_cs)
        主窗体.显示结束标语
        线程数量 = 线程数量 - 1
    Call LeaveCriticalSection(g_cs)
    '函数结束的时候，线程自然就结束了，不需要调用下面注释中的 ExitThread 函数。
    'ExitThread
End Function

Public Function 线程函数2(ByVal 参数 As Long) As Long
    Call EnterCriticalSection(g_cs)
        线程数量 = 线程数量 + 1
    Call LeaveCriticalSection(g_cs)
    Dim i As Long
    For i = 0 To 100000
        Call EnterCriticalSection(g_cs)
            If 结束所有线程操作 Then
                Call LeaveCriticalSection(g_cs)
                Exit For
            End If
            主窗体.tr2.Caption = i
            共享变量 = 共享变量 + 1
            主窗体.tr.Caption = 共享变量
        Call LeaveCriticalSection(g_cs)
    Next
    Call EnterCriticalSection(g_cs)
        主窗体.显示结束标语
        线程数量 = 线程数量 - 1
    Call LeaveCriticalSection(g_cs)
    '函数结束的时候，线程自然就结束了，不需要调用下面注释中的 ExitThread 函数。
    'ExitThread
End Function