大讨论！！！用VB实现多线程的方法。

[cbzdream]

看了些以前的帖子，了解到，用VB实现多线程有两个方法：
1，使用API中的CreateThead创建多线程
2，使用ActiveX EXE来实现多线程。
其中方法1创建的多线程不稳定，效果不好。怎么用方法2创建我不清楚。请高手指点。
大家讨论一下！！！！！！谢谢！

[海牛]

ActiveX EXE可以理解成多进程吧！！！

[cbzdream]

to Rick110AAA:具体怎么实现呢？？？

[cbzdream]

等待高手解答中。。。。。。。。。。。。。。。。。。。。。。。。

[cbzdream]

高手呢？

[海牛]

帮你Up!

[clansoft]

vb多线程先天不足！

[scegg]

同意楼上的，转到.Net多方便。

[cbzdream]

还是不清楚。

[online]

类模块clsThreads.cls
Option Explicit
Option Compare Text
Option Base 0

Private Type udtThread
Handle As Long
Enabled As Boolean
End Type

Private uThread As udtThread

Private Const CREATE_SUSPENDED As Long = &H4
Private Const THREAD_BASE_PRIORITY_IDLE As Long = -15
Private Const THREAD_BASE_PRIORITY_LOWRT As Long = 15
Private Const THREAD_BASE_PRIORITY_MAX As Long = 2
Private Const THREAD_BASE_PRIORITY_MIN As Long = -2
Private Const THREAD_PRIORITY_HIGHEST As Long = THREAD_BASE_PRIORITY_MAX
Private Const THREAD_PRIORITY_LOWEST As Long = THREAD_BASE_PRIORITY_MIN
Private Const THREAD_PRIORITY_ABOVE_NORMAL As Long = (THREAD_PRIORITY_HIGHEST - 1)
Private Const THREAD_PRIORITY_BELOW_NORMAL As Long = (THREAD_PRIORITY_LOWEST + 1)
Private Const THREAD_PRIORITY_IDLE As Long = THREAD_BASE_PRIORITY_IDLE
Private Const THREAD_PRIORITY_NORMAL As Long = 0
Private Const THREAD_PRIORITY_TIME_CRITICAL As Long = THREAD_BASE_PRIORITY_LOWRT

Private 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
Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Private Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Public Sub Initialize(ByVal lpfnBasFunc As Long)

Dim lStackSize As Long, lCreationFlags As Long, lpThreadId As Long, lNull As Long

On Error Resume Next
lNull = 0
lStackSize = 0
lCreationFlags = CREATE_SUSPENDED
uThread.Handle = CreateThread(lNull, lStackSize, lpfnBasFunc, lNull, lCreationFlags, lpThreadId)
If uThread.Handle = lNull Then MsgBox "Create thread failed!"

End Sub
Public Property Get Enabled() As Boolean

On Error Resume Next
Enabled = uThread.Enabled

End Property
Public Property Let Enabled(ByVal vNewValue As Boolean)

On Error Resume Next
If vNewValue And (Not uThread.Enabled) Then
ResumeThread uThread.Handle
uThread.Enabled = True
ElseIf uThread.Enabled Then
SuspendThread uThread.Handle
uThread.Enabled = False
End If

End Property
Public Property Get Priority() As Long

On Error Resume Next
Priority = GetThreadPriority(uThread.Handle)

End Property
Public Property Let Priority(ByVal vNewValue As Long)

On Error Resume Next
If vNewValue = -2 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_LOWEST)
ElseIf vNewValue = -1 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_BELOW_NORMAL)
ElseIf vNewValue = 0 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_NORMAL)
ElseIf vNewValue = 1 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_ABOVE_NORMAL)
ElseIf vNewValue = 2 Then
Call SetThreadPriority(uThread.Handle, THREAD_PRIORITY_HIGHEST)
End If

End Property
Private Sub Class_Terminate()

On Error Resume Next
Call TerminateThread(uThread.Handle, 0)

End Sub

[online]

模块
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Sub FlickerTop()

Static BgColor As Long
Dim lTick As Long, lCounter As Long

On Error Resume Next
For lCounter = 0 To 5999
If BgColor <> &HFF& Then BgColor = &HFF& Else BgColor = &HFF00&
Form1.Picture1.BackColor = BgColor
lTick = GetTickCount
While GetTickCount - lTick < 1250
Wend
Next

End Sub
Public Sub FlickerBottom()

Static BgColor As Long
Dim lTick As Long, lCounter As Long

On Error Resume Next
For lCounter = 0 To 5999
If BgColor <> &HFFFF& Then BgColor = &HFFFF& Else BgColor = &HFF0000
Form1.Picture2.BackColor = BgColor
lTick = GetTickCount
While GetTickCount - lTick < 500
Wend
Next

End Sub

form窗口
Option Explicit
Private Sub Command1_Click()

Dim myThreadTop As New clsThreads, myThreadBottom As New clsThreads

On Error Resume Next
With myThreadTop
.Initialize AddressOf FlickerTop
.Enabled = True
End With
With myThreadBottom
.Initialize AddressOf FlickerBottom
.Enabled = True
End With

MsgBox "Let's wait and see what happens..."

Set myThreadTop = Nothing
Set myThreadBottom = Nothing

End Sub

[cbzdream]

怎么使用Active exe实现多线程？？？？？？请详细讲解。

[yo_jo]

我也迷茫！！
高手请进呀！
帮你顶

[j4sxw]

ActiveX EXE多进程
通讯不方便

[aha99]

建议使用Active exe，我们这里都是这么用的。因为你如果直接create不知道什么时候就会莫名其妙的 over 了，一点机会都不给你，甚至系统都要重新安装，我是深受其害。。。

[rainstormmaster]

建议使用Active exe实现多线程

[tmj]

up

[cbzdream]

还是没人解答。郁闷中。。。。。。。。。。。。。。。。。。。。。。。。

[sunmaoyou]

从水母上转的！大家看看！
【 原文由 RoachCock 所发表 】
对VB来说，实现多线程比较费尽，因为VB通常是单线程的
因此，我把VB本身的功能看成不能重入的，用一个临界区保护起来
当按按钮的时候创建两个线程，同时对标签文字加1
注意，只按一次，因为我没有关闭句炳


窗体文件，有一个按钮，两个标签

VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdStart
Caption = "Start"
Height = 255
Left = 480
TabIndex = 0
Top = 360
Width = 855
End
Begin VB.Label Label2
Caption = " 0"
Height = 255
Left = 1680
TabIndex = 2
Top = 840
Width = 1575
End
Begin VB.Label Label1
Caption = " 0"
Height = 255
Left = 1680
TabIndex = 1
Top = 360
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim hThread1 As Long, hThread2 As Long
Private Sub cmdStart_Click()
hThread1 = Module1.NewThread(0)
hThread2 = NewThread(1)
End Sub
Private Sub Form_Load()
hThread1 = -1
hThread1 = -1
InitMultiThread
End Sub
Private Sub Form_Unload(Cancel As Integer)
CloseHandle (hThread1)
CloseHandle (hThread2)
UninitMultiThread
End Sub

模块文件
Option Explicit
Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Lo
ng, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As
Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Lon
g
Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVa
l dwExitCode As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Type CRITICAL_SECTION
dummy As Long
End Type
Declare Sub InitializeCriticalSection Lib "kernel32" (lpCriticalSection As C
RITICAL_SECTION)
Declare Sub EnterCriticalSection Lib "kernel32" (lpCriticalSection As CRITIC
AL_SECTION)
Declare Sub LeaveCriticalSection Lib "kernel32" (lpCriticalSection As CRITIC
AL_SECTION)
Declare Sub DeleteCriticalSection Lib "kernel32" (lpCriticalSection As CRITI
CAL_SECTION)
Dim cs As CRITICAL_SECTION '一个临界区
Function ThreadProc(ByRef Param As Long) As Long
Dim i As Long
For i = 0 To 10000
EnterVB '访问资源了
Form1.Label1 = Form1.Label1 + 1
LeaveVB '释放资源了
Next
ThreadProc = 0
End Function
Public Function NewThread(ByVal Param As Long) As Long
NewThread = CreateThread(0, 0, AddressOf ThreadProc, 0, 0, 0)
End Function
Sub InitMultiThread()
InitializeCriticalSection cs
End Sub
Sub UninitMultiThread()
DeleteCriticalSection cs
End Sub
Sub EnterVB()
EnterCriticalSection cs
End Sub
Sub LeaveVB()
LeaveCriticalSection cs
End Sub

[Sean918]

前段时间研究过，纯用VB的话，还是放弃好了

[cbzdream]

怎么使用Active exe实现多线程？？？？？？请详细讲解。