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