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