用VB实现XMLHttp Pool

昨天看了鸟食轩的文章构建一个pool来管理无刷新页面的xmlhttp对象 ,自己用VB6实现了一下,结果出现了一点小问题,总结一下。

代码:

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 = o

End Sub

在原先的JavaScript的代码中没有黄色代码对应的语句,因此在VB6的调试过程中一点一个XMlHttp对象被用过后readyState状态一直是4,所以就不在触发OnReadyStateChange事件了,因此responseText只能显示一次,以后就无法工作了,最后加上o.abort一切搞定。