'请将该部分数据保存为 zpub.bas 文件'线程安全属性数据结构；
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_SECTIONFunction StrReplace(ByVal S As String, ByVal P As String, ByVal R As String) As String
Dim re As RegExp
Set re = New RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = P
StrReplace = re.Replace(S, R)
End FunctionPublic Function GetHtml(sUrl As String, xuanze) As String
Dim Http As New MSXML2.XMLHTTP '定义一个XMLHTTP对像
Http.Open "GET", sUrl, False
Http.send
Dim objstream As New ADODB.Stream '定义一个stream，因为读过来的直接拿出来是乱码的，所以得处理一下
'Set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode = 3
objstream.Open
objstream.Write Http.responseBody
objstream.Position = 0
objstream.Type = 2
objstream.Charset = xuanze 'UTF-8 gb2312
GetHtml = objstream.ReadText '转好码，就放到html里，好关闭这些对像
objstream.Close
Set objstream = Nothing
Set Http = Nothing
End FunctionSub Rchat1()
Dim chat1
Dim A() As String
'新旗舰中心
''''Dim i
Dim dc As Long dc = GetDC(formhandle)
Do While i < 1000000
chat1 = StrReplace(GetHtml("www.sina.com.cn", "gb2312"), "\s", "") '赫赫,去掉所有空格待处理
Form3.RichTextBox1.Text = chat1
Call Sleep(5000)
Loop
Call ReleaseDC(formhandle, dc)
End Sub
------------------------------------------------'下面是窗体代码 ,窗体上只有richtextbox一控件Private Sub Form_Load()
Dim threadid1 As Long
Zpub.formhandle = Form3.hwnd
CreateThread Null, 0, AddressOf Zpub.Rchat1, VarPtr(0), 0, threadid1
End Sub-------------------------------------------------------目的:用timer控件由于要取得网页源代码,故程序运行时会产生延迟(如果不注意感觉好象死机)
所以使用多线程
问题:按如上代码richtextbox里面没有任何东西显示望各位高手能够帮忙!谢谢了
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_SECTIONFunction StrReplace(ByVal S As String, ByVal P As String, ByVal R As String) As String
Dim re As RegExp
Set re = New RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = P
StrReplace = re.Replace(S, R)
End FunctionPublic Function GetHtml(sUrl As String, xuanze) As String
Dim Http As New MSXML2.XMLHTTP '定义一个XMLHTTP对像
Http.Open "GET", sUrl, False
Http.send
Dim objstream As New ADODB.Stream '定义一个stream，因为读过来的直接拿出来是乱码的，所以得处理一下
'Set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode = 3
objstream.Open
objstream.Write Http.responseBody
objstream.Position = 0
objstream.Type = 2
objstream.Charset = xuanze 'UTF-8 gb2312
GetHtml = objstream.ReadText '转好码，就放到html里，好关闭这些对像
objstream.Close
Set objstream = Nothing
Set Http = Nothing
End FunctionSub Rchat1()
Dim chat1
Dim A() As String
'新旗舰中心
''''Dim i
Dim dc As Long dc = GetDC(formhandle)
Do While i < 1000000
chat1 = StrReplace(GetHtml("www.sina.com.cn", "gb2312"), "\s", "") '赫赫,去掉所有空格待处理
Form3.RichTextBox1.Text = chat1
Call Sleep(5000)
Loop
Call ReleaseDC(formhandle, dc)
End Sub
------------------------------------------------'下面是窗体代码 ,窗体上只有richtextbox一控件Private Sub Form_Load()
Dim threadid1 As Long
Zpub.formhandle = Form3.hwnd
CreateThread Null, 0, AddressOf Zpub.Rchat1, VarPtr(0), 0, threadid1
End Sub-------------------------------------------------------目的:用timer控件由于要取得网页源代码,故程序运行时会产生延迟(如果不注意感觉好象死机)
所以使用多线程
问题:按如上代码richtextbox里面没有任何东西显示望各位高手能够帮忙!谢谢了
反正我的编译期怎么也运行不起来多线程。
我自己写了个测试createTread的demo,始终不成功