|
代码：
Form：Form1
Option Explicit
Private Pools As HttpPool
Private Sub Command1_Click()
Dim o As MSXML2.XMLHTTP
Set o = Pools.GetObject()
Dim Handler As MyReadyStateHandler
Set Handler = New MyReadyStateHandler
Handler.ini o
o.OnReadyStateChange = Handler
o.open "GET","Http://localhost/js/message.htm",True
o.send
Set Handler = Nothing
End Sub
Private Sub Form_Load()
Set Pools = New HttpPool
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set Pools = Nothing
End Sub
Class：HttpPool
Option Explicit
Dim Pool As Collection
'没有考虑池容量
Public Function GetObject() As MSXML2.XMLHTTP
Dim i As Integer
Dim o As MSXML2.XMLHTTP
For i = 1 To Pool.Count
Set o = Pool(i)
If o.readyState = 4 Or o.readyState = 0 Then
o.abort
GoTo ExitLabel
End If
Next
Set o = New MSXML2.XMLHTTP
Pool.Add o
ExitLabel:
Set GetObject = o
Debug.Print Pool.Count
End Function
Private Sub Class_Initialize()
Set Pool = New Collection
End Sub
Private Sub Class_Terminate()
Dim i As Integer
For i = 1 To Pool.Count
Pool(i).abort
Next
Set Pool = Nothing
End Sub
Option Explicit
Dim p As XMLHTTP
Sub OnReadyStateChange()
If p.readyState = 4 Then
Debug.Print p.responseText
End If
End Sub
Class：MyReadyStateHandler
Public Sub ini(o As XMLHTTP) Set p = oEnd Sub在原先的JavaScript的代码中没有黄色代码对应的语句，因此在VB6的调试过程中一点一个XMlHttp对象被用过后readyState状态一直是4，所以就不在触发OnReadyStateChange事件了，因此responseText只能显示一次，以后就无法工作了，最后加上o.abort一切搞定。 （编辑：李大同）
【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
|
