用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一切搞定。