form:Private Sub Command1_Click()
'声明了线程ID
Dim threadid1 As Long
Dim threadid2 As Long
'参数一,lpThreadAttributes 线程安全属性,传递为NULL
'参数二,dwStackSize ,线程堆栈大小,可以为0,表示堆栈和此应用堆栈相同
'参数三,lpstartAddress ,执行函数地址,用AddressOf 获取
'参数四,lpParameter ,执行函数的参数地址,可以是一个记录或者是别的类型,用VarPtr获取参数地址(varptr为未公开函数)!!
'参数五,dwCreationFlags ,表示线程创建后的状态!,0表示立即运行,create_SUSPENDED表示线程挂起
'参数六,lpThreadID 表示分配给线程的线程号
Call CreateThread(Null, ByVal O&, AddressOf Module1.ThreadProc1, VarPtr(0), ByVal 0&, threadid1)
Call CreateThread(Null, ByVal 0&, AddressOf Module1.ThreadProc2, VarPtr(0), ByVal 0&, threadid2)
End SubPrivate Sub Command2_Click()
Unload Me
End SubPrivate Sub Form_Load()
FormHandle = Form1.hWnd
End Sub
module:'线程安全属性数据结构;
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type'这个是用于多线程访问临界资源同步Api的数据结构
Public Type CRITICAL_SECTION
Dummy As Long
End TypePublic Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Sub EnterCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION) '进入临界区
Public Declare Sub LeaveCriticalSection Lib "kernel32" (lpCriticalSection As CRITICAL_SECTION) '离开临界区Public FormHandle As Long
Public Sect As CRITICAL_SECTION
Public Fso As Scripting.FileSystemObjectPublic Sub ThreadProc1()
While True
WriteLog "test1.log", "ThreadProc1"
Call Sleep(5000)
Wend
'Call EnterCriticalSection(Sect)
'Call LeaveCriticalSection(Sect)
End SubPublic Sub ThreadProc2()
While True
WriteLog "test2.log", "ThreadProc2"
Call Sleep(3000)
Wend
'Call EnterCriticalSection(Sect)
'Call LeaveCriticalSection(Sect)
End SubPublic Sub WriteLog(ByVal FileName As String, ByVal Status As String)
If Not Fso.FileExists(App.Path & "\" & FileName) Then
Fso.CreateTextFile (App.Path & "\" & FileName)
End If
Set File = Fso.OpenTextFile(App.Path & "\" & FileName, ForAppending)
File.WriteLine Status
File.Close
Set File = Nothing
End Sub
Call CreateThread(Null, ByVal O&, AddressOf Module1.ThreadProc1, VarPtr(0), ByVal 0&, threadid1)
Call CreateThread(Null, ByVal 0&, AddressOf Module1.ThreadProc2, VarPtr(0), ByVal 0&, threadid2)
http://www.china-askpro.com/msg22/qa66.shtml