VB 使用 XMLHttp Pool 的例子

代码：Form：Form1Option 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 = NothingEnd Sub

Private Sub Form_Load()    Set Pools = New HttpPoolEnd Sub

Private Sub Form_Unload(Cancel As Integer)    Set Pools = NothingEnd SubClass：HttpPoolOption 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 oExitLabel:    Set GetObject = o    Debug.Print Pool.CountEnd Function

Private Sub Class_Initialize()    Set Pool = New CollectionEnd Sub

Private Sub Class_Terminate()    Dim i As Integer    For i = 1 To Pool.Count        Pool(i).abort    Next    Set Pool = NothingEnd SubOption Explicit

Dim p As XMLHTTP

Sub OnReadyStateChange()    If p.readyState = 4 Then        Debug.Print p.responseText    End IfEnd SubClass：MyReadyStateHandler

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