CreateThread在VB6中是否不能正常运行？ 我的代码如下：模块: 'Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongSub main() Load Form1 Form1.Show End Sub Public Sub c1() '....... LTDelay 2 MsgBox "OK1" End SubPublic Sub c2() '...... LTDelay 2 MsgBox "OK2" End SubPublic Function LTDelay(ByVal lSec As Long) As Long Dim lNow As Date LTDelay = 0 lNow = Now Do While (DateDiff("s", lNow, Now) < lSec) 'DoEvents Loop End Function 窗体： Private hthread1 As Long Private hthread2 As Long Private ithread1 As Long Private ithread2 As LongPrivate Sub Command1_Click()ithread1 = CreateThread(ByVal 0&, ByVal 2000&, AddressOf c1, ByVal 0&, ByVal 0&, hthread1) '- -´´½¨Ïß³ÌÒ» ithread2 = CreateThread(ByVal 0&, ByVal 2000&, AddressOf c2, ByVal 0&, ByVal 0&, hthread1) '- -´´½¨Ï̶߳þ LTDelay 10 CloseHandle ithread1 '- -¹Ø±ÕÏß³ÌÒ» CloseHandle ithread2 '- -¹Ø±ÕÏ̶߳þEnd Sub 跟踪的结果是，根本没运行。用过的朋友，能给个提示否？
Option ExplicitPublic Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As LongPublic id As LongPublic Function AddText() Do Form1.Text1.Text = "Adding to Text1 - " doevents Loop End FunctionOption ExplicitPrivate Sub Command1_Click() id = CreateThread(ByVal 0&, ByVal 0&, AddressOf AddText, ByVal 0&, 0, id) End SubPrivate Sub Command2_Click() Call TerminateThread(id, ByVal 0&) End Sub
问题已解决 代码如下模块中：（AddressOf 的过程不能再调用程序中其它部分！！！） 'Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPublic Sub Main() Load Form1 Form1.Show End Sub Public Sub c1() '....... Close #1 Open App.Path + "\Error.txt" For Append As #1 Print #1, CStr(Now) + ":"; "OK1 BEGIN" Close #1
Dim lNow As Date lNow = Now Do While (DateDiff("s", lNow, Now) < 6) 'DoEvents Loop
Close #1 Open App.Path + "\Error.txt" For Append As #1 Print #1, CStr(Now) + ":"; "OK1 END" Close #1 End SubPublic Sub c2() '...... Close #1 Open App.Path + "\Error.txt" For Append As #1 Print #1, CStr(Now) + ":"; "OK2 BEGIN" Close #1
Dim lNow As Date lNow = Now Do While (DateDiff("s", lNow, Now) < 6) 'DoEvents Loop
Close #1 Open App.Path + "\Error.txt" For Append As #1 Print #1, CStr(Now) + ":"; "OK2 END" Close #1 End SubPublic Function LTDelay(ByVal lSec As Long) As Long Dim lNow As Date LTDelay = 0 lNow = Now Do While (DateDiff("s", lNow, Now) < lSec) 'DoEvents Loop End Function Public Function WriteLog(lData As String) On Error GoTo Exec_Error Close #1 Open App.Path + "\Error.txt" For Append As #1 Print #1, CStr(Now) + ":"; lData Close #1 Exit Function Exec_Error: MsgBox "дÈÕÖ¾Îļþ³ö´í:" + Err.Description, vbCritical + vbOKOnly, "³ö´í!" End Function 窗体中： Private hthread1 As Long Private hthread2 As Long Private ithread1 As Long Private ithread2 As LongPrivate Sub Command1_Click() Dim lRet As Longithread1 = CreateThread(ByVal 0&, ByVal 0&, AddressOf c1, ByVal 0&, ByVal 0&, hthread1) '- -´´½¨Ïß³ÌÒ» LTDelay 4 ithread2 = CreateThread(ByVal 0&, ByVal 0&, AddressOf c2, ByVal 0&, ByVal 0&, hthread1) '- -´´½¨Ï̶߳þWriteLog "Delay 10 BEGIN" LTDelay 20 WriteLog "Delay 10 END"CloseHandle ithread1 '- -¹Ø±ÕÏß³ÌÒ» CloseHandle ithread2 '- -¹Ø±ÕÏ̶߳þEnd Sub
我的代码如下：模块:
'Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongSub main()
Load Form1
Form1.Show
End Sub
Public Sub c1()
'.......
LTDelay 2
MsgBox "OK1"
End SubPublic Sub c2()
'......
LTDelay 2
MsgBox "OK2"
End SubPublic Function LTDelay(ByVal lSec As Long) As Long
Dim lNow As Date
LTDelay = 0
lNow = Now
Do While (DateDiff("s", lNow, Now) < lSec)
'DoEvents
Loop
End Function
窗体：
Private hthread1 As Long
Private hthread2 As Long
Private ithread1 As Long
Private ithread2 As LongPrivate Sub Command1_Click()ithread1 = CreateThread(ByVal 0&, ByVal 2000&, AddressOf c1, ByVal 0&, ByVal 0&, hthread1) '- -´´½¨Ïß³ÌÒ»
ithread2 = CreateThread(ByVal 0&, ByVal 2000&, AddressOf c2, ByVal 0&, ByVal 0&, hthread1) '- -´´½¨Ï̶߳þ
LTDelay 10
CloseHandle ithread1 '- -¹Ø±ÕÏß³ÌÒ»
CloseHandle ithread2 '- -¹Ø±ÕÏ̶߳þEnd Sub
跟踪的结果是，根本没运行。用过的朋友，能给个提示否？
Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As LongPublic id As LongPublic Function AddText()
Do
Form1.Text1.Text = "Adding to Text1 - "
doevents
Loop
End FunctionOption ExplicitPrivate Sub Command1_Click()
id = CreateThread(ByVal 0&, ByVal 0&, AddressOf AddText, ByVal 0&, 0, id)
End SubPrivate Sub Command2_Click()
Call TerminateThread(id, ByVal 0&)
End Sub
代码如下模块中：（AddressOf 的过程不能再调用程序中其它部分！！！）
'Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPublic Sub Main()
Load Form1
Form1.Show
End Sub
Public Sub c1()
'.......
Close #1
Open App.Path + "\Error.txt" For Append As #1
Print #1, CStr(Now) + ":"; "OK1 BEGIN"
Close #1
Dim lNow As Date
lNow = Now
Do While (DateDiff("s", lNow, Now) < 6)
'DoEvents
Loop
Close #1
Open App.Path + "\Error.txt" For Append As #1
Print #1, CStr(Now) + ":"; "OK1 END"
Close #1
End SubPublic Sub c2()
'......
Close #1
Open App.Path + "\Error.txt" For Append As #1
Print #1, CStr(Now) + ":"; "OK2 BEGIN"
Close #1
Dim lNow As Date
lNow = Now
Do While (DateDiff("s", lNow, Now) < 6)
'DoEvents
Loop
Close #1
Open App.Path + "\Error.txt" For Append As #1
Print #1, CStr(Now) + ":"; "OK2 END"
Close #1
End SubPublic Function LTDelay(ByVal lSec As Long) As Long
Dim lNow As Date
LTDelay = 0
lNow = Now
Do While (DateDiff("s", lNow, Now) < lSec)
'DoEvents
Loop
End Function
Public Function WriteLog(lData As String)
On Error GoTo Exec_Error
Close #1
Open App.Path + "\Error.txt" For Append As #1
Print #1, CStr(Now) + ":"; lData
Close #1
Exit Function
Exec_Error:
MsgBox "дÈÕÖ¾Îļþ³ö´í:" + Err.Description, vbCritical + vbOKOnly, "³ö´í!"
End Function
窗体中：
Private hthread1 As Long
Private hthread2 As Long
Private ithread1 As Long
Private ithread2 As LongPrivate Sub Command1_Click()
Dim lRet As Longithread1 = CreateThread(ByVal 0&, ByVal 0&, AddressOf c1, ByVal 0&, ByVal 0&, hthread1) '- -´´½¨Ïß³ÌÒ»
LTDelay 4
ithread2 = CreateThread(ByVal 0&, ByVal 0&, AddressOf c2, ByVal 0&, ByVal 0&, hthread1) '- -´´½¨Ï̶߳þWriteLog "Delay 10 BEGIN"
LTDelay 20
WriteLog "Delay 10 END"CloseHandle ithread1 '- -¹Ø±ÕÏß³ÌÒ»
CloseHandle ithread2 '- -¹Ø±ÕÏ̶߳þEnd Sub