.NET开发

本类阅读TOP10

·NHibernate快速指南(翻译)
·vs.net 2005中文版下载地址收藏
·【小技巧】一个判断session是否过期的小技巧
·VB/ASP 调用 SQL Server 的存储过程
·?dos下编译.net程序找不到csc.exe文件
·通过Web Services上传和下载文件
·学习笔记(补)《.NET框架程序设计(修订版)》--目录
·VB.NET实现DirectDraw9 (2) 动画
·VB.NET实现DirectDraw9 (1) 托管的DDraw
·建站框架规范书之——文件命名

分类导航
VC语言Delphi
VB语言ASP
PerlJava
Script数据库
其他语言游戏开发
文件格式网站制作
软件工程.NET开发
在VB中实现多线程!

作者:未知 来源:月光软件站 加入时间:2005-2-28 月光软件站

'功能:创建多线程类,用于初始化线程。   类名:cls_Thread

'参数:LongPointFunction 用于接收主调过程传递过来的函数地址值

'调用方法:1.声明线程类对象变量 Dim mythread as cls_Thread

'          2.调用形式:With mythread

'                         .Initialize AddressOf 自定义过程或函数名 '(初始化线程) .

'                         .ThreadEnabled = True                  '(设置线程是否激活)

'                      End With

'          3.终止调用: Set mythread = Nothing

'   Email:[email protected]

'   Test On: VB6.0+Win2000  AND  VB6.0+WinXP     It's Pass !

 

Option Explicit

'创建线程API

'此API经过改造,lpThreadAttributes改为Any型,lpStartAddress改为传值引用:

'因为函数的入口地址由形参变量传递,如果用传址那将传递形参变量的地址而不是函数的入口地址

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

'终止线程API

Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long

'激活线程API

Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long

'挂起线程API

Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long

 

Private Const CREATE_SUSPENDED = &H4    '线程挂起常量

 

'自定义线程结构类型

Private Type udtThread

        Handle As Long

        Enabled As Boolean

End Type

 

Private meTheard As udtThread

'初始化线程

Public Sub Initialize(ByVal LongPointFunction As Long)

       Dim LongStackSize As Long, LongCreationFlags As Long, LpthreadId As Long, LongNull As Long

       On Error Resume Next

       LongNull = 0

       LongStackSize = 0

       LongCreationFlags = CREATE_SUSPENDED         '创建线程后先挂起,由程序激活线程

      

       '创建线程并返线程句柄

       meTheard.Handle = CreateThread(LongNull, LongStackSize, ByVal LongPointFunction, LongNull, LongCreationFlags, LpthreadId)

      

       If meTheard.Handle = LongNull Then

          MsgBox "线程创建失败!", 48, "错误"

       End If

End Sub

 

'获取线程是否激活属性

Public Property Get ThreadEnabled() As Boolean

       On Error Resume Next

       Enabled = meTheard.Enabled

End Property

 

'设置线程是否激活属性

Public Property Let ThreadEnabled(ByVal Newvalue As Boolean)

       On Error Resume Next

       '若激活线程(Newvalue为真)设为TRUE且此线程原来没有激活时激活此线程

       If Newvalue And (Not meTheard.Enabled) Then

          ResumeThread meTheard.Handle

          meTheard.Enabled = True

       Else          '若激活线程(Newvalue为真)且此线程原来已激活则挂起此线程

          If meTheard.Enabled Then

             SuspendThread meTheard.Handle

             meTheard.Enabled = False

          End If

       End If

End Property

 

'终止线程事件

Private Sub Class_Terminate()

        On Error Resume Next

        Call TerminateThread(meTheard.Handle, 0)

End Sub


 




相关文章

相关软件