如何在VB中使用多线程？在线等待！！

Question

如何在VB中使用多线程，最好能给我一个例子，不胜感激。

Answer 1

http://www.china-askpro.com/msg2/qa20.shtmlVB 虽然可以进行多线程编程，但的确不太稳定，建议用VC或.net作

Answer 2

这个问题，讨论过很多次：比较不好做，紖用一下：
  
标题     vb实现多线程！    S.F.（原作）  
昨晚2:30的时候还没睡着，觉得有必要把vb编写多线程程序再次写一次；主要是以前忽略的细节和重要的环节；今天在公司打开一年多没用的vb，写了如下的代码；想写多线程的朋友可以调试一下看看，关于多线程的任务模式，同步和互斥，临界资源和临界区（文中提到）欢迎跟帖讨论； 
'请将该部分数据保存为 FORM1.frm 文件 
VERSION 5.00 
Begin VB.Form Form1 
  Caption       =   "多线程" 
   ClientHeight    = 3195 
   ClientLeft      =   60 
   ClientTop      = 345 
   ClientWidth     = 6450 
   LinkTopic      =   "Form1" 
   ScaleHeight     = 3195 
   ScaleWidth      = 6450 
   StartUpPosition =   3  '窗口缺省 
   Begin VB.TextBox Text1 
    Height        = 270 
  Left        = 960 
      TabIndex     = 2 
  Text        = "2" 
  Top        = 2760 
   Width        = 2415 
  End 
   Begin VB.CommandButton Command2 
     Caption       =   "返回" 
    Height        = 255 
  Left        = 3480 
      TabIndex     = 1 
  Top        = 2760 
   Width        = 1455 
  End 
   Begin VB.CommandButton Command1 
     Caption       =   "Start Count" 
    Height        = 255 
  Left        = 3480 
      TabIndex     = 0 
  Top        = 240 
   Width        = 1455 
  End 
   Begin VB.Label Label1 
      AutoSize    =   -1 'True 
     Caption       =   "主线程执行结果测试:" 
    Height        = 180 
  Left        = 600 
      TabIndex     = 3 
  Top        = 2400 
   Width        = 1710 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False  '下载地址:http://www.bssoft.com.cn/vbThread.rar 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.OutText1, VarPtr(0), ByVal 0&, threadid1) 
    Call CreateThread(Null, ByVal 0&, AddressOf Module1.OutText2, VarPtr(0), ByVal 0&, threadid2) 
    
End Sub Private Sub Command2_Click() 
'该事件运行于主线程！ 
    Dim i As Long 
    i = CLng(Text1.Text) 
    Text1.Text = CStr(i * i)  '不要点击次数太多，LONG 类型会溢出 
End Sub Private Sub Form_Load() 
'保存窗体句柄全局变量，用于在form 上绘图 
    formhandle = Form1.hwnd 
End Sub 
---------------------------------- 
'请将该部分数据保存为 Module1.bas 文件 
Attribute VB_Name = "Module1" '线程安全属性数据结构； 
Public Type SECURITY_ATTRIBUTES 
       nLength As Long 
        lpSecurityDescriptor As Long 
        bInheritHandle As Long 
End Type '这个是用于多线程访问临界资源同步Api的数据结构 
Public Type CRITICAL_SECTION 
    dummy As Long 
End Type 
'为什么用GDI 函数绘图？原因等下再讲 
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long 
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long 
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long 
'请注意；createThread APi声明已被我修改过，修改的地方请自行参照APIView复制的内容 
Public 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 
'这个是sleep,作用就是让两个线程绘图频率不一致，效果才明显。 
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)  '离开临界区 '几个重要的函数举例 
'ObjPtr：返回对象实例私有域的地址。 
'StrPtr：返回字符串第一个字的地址。 
'VarPtr：返回变量的地址。 '全局的form的句柄！ 
Public formhandle As Long 
'临界数据结构 
Public sect As CRITICAL_SECTION Sub OutText1()  '过程一 
Dim i As Long 
Dim dc As Long 
Dim s As String 
    dc = GetDC(formhandle) '获取窗体句柄的DC 
   For i = 1 To 100000 
        s = CStr(i) 
        Call SetBkColor(dc, &HF0F0F0)  '设置绘制区域的背景色，也起清除作用 
        Call TextOut(dc, 10, 10, s, Len(s)) '输出文本！ 
        Call Sleep(40) '等待 
  Next 
    Call ReleaseDC(formhandle, dc)  '释放资源！ 
   ' Call EnterCriticalSection(sect) 
   ' 上下表示该处为临界区，如果要对工程全局变量做操作，最好在该区域内 
   ' 否则线程同步过程中，非常容易让程序崩溃 
   ' Call LeaveCriticalSection(sect) 
End Sub Sub OutText2()  '和过程一类似 
Dim i As Long 
Dim dc As Long 
Dim s As String 
    dc = GetDC(formhandle) 
   For i = 1 To 100000 
        s = CStr(i) 
        Call SetBkColor(dc, &HF0F0F0) 
        Call TextOut(dc, 10, 80, s, Len(s))  '文本位置改变了 
        Call Sleep(20) '延时改变了 
  Next 
    Call ReleaseDC(formhandle, dc) 
   ' Call EnterCriticalSection(sect) 
  '  Call LeaveCriticalSection(sect) 
End Sub 
'关于为何使用gdi 函数输出文本，这是一个很重要的内容； 
'程序在记数时用了难用的TextOut 函数，而没有使用标签控件，这是因为 
'vb的组件不都是线程安全的，当多线程访问不是线程安全的组件，那么会 
'产生严重错误。 'mailto:[email protected] 
'作者：萧寒(410000) 

Answer 3

http://www.csdn.net/develop/Read_Article.asp?Id=6278
http://www.csdn.net/develop/Read_Article.asp?Id=18660
http://www.csdn.net/develop/Read_Article.asp?Id=8566

Answer 4

我在一个线程中使用ADO访问数据库，结果提示错误，好像是没有调用CoInit....什么的，请问怎么解决?

Answer 5

从我Clock里摘代码给你 我的程序下载地址：http://h.7i24.com/vbcc/work/setup.exe
Option Explicit
'----------------------------------------------------------------
' CreateThread          创建一个线程
' GetExitCodeThread     取退出线程的代码
' ResumeThread          激活一个线程
' Sleep                 是睡觉函数（可以使你的线程睡觉） :) 我喜欢睡觉
' CloseHandle           关闭一个打开物体的句柄 适用于很多句柄Private Declare Function CreateThread Lib "kernel32" (ByVal pThreadAttributes As Long, 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 GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPublic Function CreateNewThread(ThreadProc As Long)
    Dim hThread As Long
    Dim ThreadID As Long
    hThread = CreateThread(0, 0, ThreadProc, 0, 0, ThreadID)
    Call CloseHandle(hThread)
End FunctionPrivate Function HourPlaySound() As Long
    ' 正点报时（由于MCI播放MID窗体会停止刷新故启动另一线程）
    If HourRing <> 0 And Right$(Time, 5) = "00:00" Then
        If waveOutGetNumDevs > 0 And midiOutGetNumDevs > 0 Then
            Call Thread.CreateNewThread(AddressOf PlayRingSound)
        Else
            Call Thread.CreateNewThread(AddressOf BugleSound)
        End If
  End If
End Function