Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > microsoft.public.excel.programming > #109787 > unrolled thread

Web reads - synchronous and asynchronous - long

Back to article view | Back to microsoft.public.excel.programming

Contents

  Web reads - synchronous and asynchronous - long Walter Briscoe <wbriscoe@nospam.demon.co.uk> - 2017-01-11 12:41 +0000
    Re: Web reads - synchronous and asynchronous - long GS <gs@v.invalid> - 2017-01-11 12:36 -0500

#109787 — Web reads - synchronous and asynchronous - long

Last year, Garry pointed me at synchronous XML HTTP read techniques.
They are faster than calling Internet Explorer from Excel.
Asynchronous access has potential to be faster as operations happen in
parallel.
I learnt a lot from
<http://www.tushar-mehta.com/publish_train/xl_vba_cases/vba_web_pages_se
rvices/index.htm>
That shows how to set up a class to manage XML HTTP accesses.
It lacks a capability to limit the number of active asynchronous
requests.

I have written the following code:

To create a new module with a specified name in Excel 2003:
1) in the Visual Basic Editor (VBE), click Insert/Module.
2) click View/properties Window
3) change the field after (name) to the desired name from Module<n>

This is a module, I called TestXMLHttp.

Option Explicit

' Module TestXMLHttp exercises clsXMLHttpManager and clsXMLHttpMonitor
' This version accesses several Transport for London bus stops.
' TfLbus2bProcessor is used to analyse responses.
' synchronous and threads in clsXMLHttpManager control behaviour.

' Wait for a fixed time
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' Milliseconds since system started.
Public Declare Function timeGetTime Lib "winmm.dll" () As Long

' Instance used to control XMLHttp
Dim XMLHttpManager As New clsXMLHttpManager

Public accesses As Long ' Maintained by class clsHttpManager

Sub testAsyncIntegrated()
    Dim start As Long

    start = timeGetTime
    accesses = 0 ' Has to be initialized
    XMLHttpManager.synchronous = False
    XMLHttpManager.threads = 3
    geturl "https://tfl.gov.uk/bus/stop/490000014B/barbican-station"
    geturl "https://tfl.gov.uk/bus/stop/490004005S/billingsgate-market"
    geturl "https://tfl.gov.uk/bus/stop/490004202W/bouverie-road"
    geturl "https://tfl.gov.uk/bus/stop/490005357N/clarendon-road"
    geturl "https://tfl.gov.uk/bus/stop/490006295D/chaplin-road"
    geturl "https://tfl.gov.uk/bus/stop/490006646N/essex-road-south"
    geturl "https://tfl.gov.uk/bus/stop/490006722S/falcon-grove"
    geturl "https://tfl.gov.uk/bus/stop/490007971E/hornsey-road"
    geturl "https://tfl.gov.uk/bus/stop/490008376N/horse-guards-parade"
    geturl "https://tfl.gov.uk/bus/stop/490004905S/stop-absent"
    With XMLHttpManager
        Do While .XMLHttpManagerbusy
            Sleep 100
            DoEvents
        Loop
        Debug.Print "Elapsed=" & timeGetTime - start & _
            ", asynchronous is " & (Not .synchronous) & _
            ", threads = " & .threads
    End With
End Sub

Private Sub geturl(ByVal URL As String)
    XMLHttpManager.XMLHttpCall "TfLbus2bProcessor", URL
End Sub

Sub TfLbus2bProcessor(Me2 As clsXMLHttpMonitor)
    ' Dummy processor for https://tfl.gov.uk/bus/stop/... reads
    With Me2
        Debug.Print "accesses=" & accesses & ", index=" & .index & _
            ", ElapsedTime=" & .ElapsedTime & _
            ", """ & .sURL & """ Is " & _
            Len(.XMLHttpReq.responseText) & _
            " bytes, starting """ & _
            Left(.XMLHttpReq.responseText, 15) & """"
    End With
End Sub

accesses ought to be a member of class clsHttpManager.
I don't know how to specify a static member of a class.

I found it useful to specify XMLHttpManager.XMLHttpManagerbusy so that
my code could wait for the completion of asynchronous requests.

To create a class module, in the VBE, Insert Class Module
This is class module clsXMLHttpManager.

' clsXMLHttpManager - control access to clsXMLHttpMonitor

Option Explicit ' Require all variables to be explicitly declared.

Private bsynchronous As Boolean
Private maxthreads As Long    ' 0 is no maximum

Dim XMLHttpMon() As clsXMLHttpMonitor   ' Array of connections

Property Get synchronous() As Boolean
    synchronous = bsynchronous
End Property

Property Let synchronous(ByVal sync As Boolean)
    bsynchronous = sync
End Property

Property Get threads() As Long
    threads = UBound(XMLHttpMon) - LBound(XMLHttpMon) + 1
End Property

Property Let threads(ByVal max As Long)
    maxthreads = max
End Property

Public Sub XMLHttpCall(ByVal RespAction As String, ByVal URL As String)
    Dim XMLHttpMon As clsXMLHttpMonitor

    Set XMLHttpMon = findAvailMon()
    XMLHttpMon.XMLHttpCall URL, RespAction, Not bsynchronous
End Sub

Public Function XMLHttpManagerbusy() As Boolean
    Dim I As Long

    For I = LBound(XMLHttpMon) To UBound(XMLHttpMon)
        If Not XMLHttpMon(I).IAmAvailable Then
            XMLHttpManagerbusy = True
            Exit Function
        End If
    Next I
End Function

Private Function findAvailMon() As clsXMLHttpMonitor
    Dim I      As Integer
    Dim Done   As Boolean

    If Not bsynchronous Then
        I = LBound(XMLHttpMon)

        Do
            If XMLHttpMon(I) Is Nothing Then
                Done = True
            ElseIf XMLHttpMon(I).IAmAvailable Then
                Done = True
            Else
                I = I + 1

                If maxthreads <> 0 And I >= maxthreads Then
                    Sleep 100
                    DoEvents
                    I = LBound(XMLHttpMon)  ' Try again after delay
                Else
                    Done = I > UBound(XMLHttpMon)
                End If
            End If
        Loop Until Done

        If I > UBound(XMLHttpMon) Then
            ReDim Preserve XMLHttpMon(UBound(XMLHttpMon) + 1)
        End If
        Set XMLHttpMon(I) = New clsXMLHttpMonitor
        XMLHttpMon(I).index = I
    Else
        Debug.Assert LBound(XMLHttpMon) = 0
        I = 0
        If XMLHttpMon(I) Is Nothing Then
            Set XMLHttpMon(I) = New clsXMLHttpMonitor
            XMLHttpMon(I).index = I
        End If
    End If
    Set findAvailMon = XMLHttpMon(I)
End Function

Private Sub Class_Initialize()
    ReDim XMLHttpMon(0)
End Sub

Properties synchronous and threads control the module.
By default, synchronous is False and threads is 0 - the maximum number
of synchronous requests is not locally limited.
When no free thread is available, the code waits.
There probably ought to be a maximum wait.

This is class module clsXMLHttpMonitor

' clsXMLHttpMonitor - Support both synchronous and asynchronous XMLHTTP

Option Explicit

' Has to be private, when declared in a class module
' Milliseconds since system started.
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

' MSXML2.XMLHTTP Needs Tools/Referencs... Microsoft XML, v 6.0
Public XMLHttpReq As MSXML2.XMLHTTP
Public IAmAvailable As Boolean
Private ResponseProcessor As String
Public sURL As String
Public index As Long
Private StartTime As Long
Public ElapsedTime As Long
Public Rho As Long
Public Col As Long

Public Sub Initialize(ByVal uXMLHttpRequest As MSXML2.XMLHTTP)
   Set XMLHttpReq = uXMLHttpRequest
End Sub

Sub ReadyStateChangeHandler()
    With XMLHttpReq
        If .readyState = 4 Then
            ElapsedTime = timeGetTime() - StartTime
            Select Case .Status
            Case 200:   ' Successful
                Application.Run ResponseProcessor, Me
            Case Else
                Debug.Print "accesses=" & accesses & _
                    ", index=" & index & _
                    ", ElapsedTime=" & ElapsedTime & _
                    ", Status=" & .Status & _
                    ", statusText=" & .statusText & ", " & _
                    Len(.responseText) & " byte response starts """ & _
                    Left(.responseText, 256) & """"
                ' Stop  ' Failure probably needs manual analysis
            End Select
            IAmAvailable = True
        End If
    End With
End Sub

Public Sub XMLHttpCall(ByVal URL As String, ByVal Action As String, _
    Optional ByVal AsyncCall As Boolean = True)
    StartTime = timeGetTime()  ' Note when called
    Set XMLHttpReq = New MSXML2.XMLHTTP
    sURL = URL
    ResponseProcessor = Action
    accesses = accesses + 1
    If ActiveCell Is Nothing Then
        Rho = 0
        Col = 0
    Else
        Rho = ActiveCell.Row
        Col = ActiveCell.Column
    End If

    With XMLHttpReq
        .Open "GET", URL, AsyncCall
        .send ' Parameter only used where ReqMethod = "POST"

        If AsyncCall Then
            XMLHttpReq.onreadystatechange = Me
        Else
            ReadyStateChangeHandler
        End If
    End With
End Sub

Class module clsXMLHttpMonitor has to me modified to support
asynchronous access.
We must make ReadyStateChangeHandler the default method for the class.
To make that happen, do the following:

1)      Export and remove this class module.

2)      Open the exported file in a text editor like Notepad.  After the
‘Sub ReadyStateChangeHandler()’ line add a new line:
Attribute Value.VB_UserMemId = 0

3)      Save the file and import it back into the VBA project.

For more details see Chip Pearson’s
<http://www.cpearson.com/excel/DefaultProperty.htm>

I had problems, which have now vanished with application.run.
I now pass Me. If that fails, use a global parameter. I do not
understand the following help text:

Remarks
You cannot use named arguments with this method. Arguments must be
passed by position.

The Run method returns whatever the called macro returns. Objects passed
as arguments to the macro are converted to values (by applying the Value
property to the object). This means that you cannot pass objects to
macros by using the Run method.

This happens with XMLHttpManager.synchronous = True ' simplest case

accesses=1, index=0, ElapsedTime=841, "https://tfl.gov.uk/bus/stop/49000
0014B/barbican-station" Is 115604 bytes, starting "<!doctype html>"
accesses=2, index=0, ElapsedTime=511, "https://tfl.gov.uk/bus/stop/49000
4005S/billingsgate-market" Is 108609 bytes, starting "<!doctype html>"
accesses=3, index=0, ElapsedTime=1630, "https://tfl.gov.uk/bus/stop/4900
04202W/bouverie-road" Is 123341 bytes, starting "<!doctype html>"
accesses=4, index=0, ElapsedTime=1450, "https://tfl.gov.uk/bus/stop/4900
05357N/clarendon-road" Is 120588 bytes, starting "<!doctype html>"
accesses=5, index=0, ElapsedTime=1223, "https://tfl.gov.uk/bus/stop/4900
06295D/chaplin-road" Is 135705 bytes, starting "<!doctype html>"
accesses=6, index=0, ElapsedTime=811, "https://tfl.gov.uk/bus/stop/49000
6646N/essex-road-south" Is 113142 bytes, starting "<!doctype html>"
accesses=7, index=0, ElapsedTime=997, "https://tfl.gov.uk/bus/stop/49000
6722S/falcon-grove" Is 137234 bytes, starting "<!doctype html>"
accesses=8, index=0, ElapsedTime=814, "https://tfl.gov.uk/bus/stop/49000
7971E/hornsey-road" Is 117312 bytes, starting "<!doctype html>"
accesses=9, index=0, ElapsedTime=633, "https://tfl.gov.uk/bus/stop/49000
8376N/horse-guards-parade" Is 189457 bytes, starting "<!doctype html>"
accesses=10, index=0, ElapsedTime=166, Status=404, statusText=Not Found,
82058 byte response starts "<!doctype html>
<!-- tfl-probe -->
<!--[if IE 7]>         <html lang="en" class="no-js lt-ie10 lt-ie9 lt-
ie8"> <![endif]-->
<!--[if IE 8]>         <html lang="en" class="no-js lt-ie10 lt-ie9">
<![endif]-->
<!--[if IE 9]>         <html lang="en" class=""
Elapsed=9136, asynchronous is False, threads = 1

This happens with XMLHttpManager.synchronous = False

accesses=10, index=1, ElapsedTime=606, "https://tfl.gov.uk/bus/stop/4900
04005S/billingsgate-market" Is 106354 bytes, starting "<!doctype html>"
accesses=10, index=2, ElapsedTime=3814, "https://tfl.gov.uk/bus/stop/490
004202W/bouverie-road" Is 118830 bytes, starting "<!doctype html>"
accesses=10, index=3, ElapsedTime=4522, "https://tfl.gov.uk/bus/stop/490
005357N/clarendon-road" Is 130961 bytes, starting "<!doctype html>"
accesses=10, index=0, ElapsedTime=5234, "https://tfl.gov.uk/bus/stop/490
000014B/barbican-station" Is 132845 bytes, starting "<!doctype html>"
accesses=10, index=4, ElapsedTime=5242, "https://tfl.gov.uk/bus/stop/490
006295D/chaplin-road" Is 133154 bytes, starting "<!doctype html>"
accesses=10, index=5, ElapsedTime=7051, "https://tfl.gov.uk/bus/stop/490
006646N/essex-road-south" Is 115402 bytes, starting "<!doctype html>"
accesses=10, index=7, ElapsedTime=8959, "https://tfl.gov.uk/bus/stop/490
007971E/hornsey-road" Is 119555 bytes, starting "<!doctype html>"
accesses=10, index=6, ElapsedTime=9269, "https://tfl.gov.uk/bus/stop/490
006722S/falcon-grove" Is 130416 bytes, starting "<!doctype html>"
accesses=10, index=9, ElapsedTime=9476, Status=404, statusText=Not
Found, 82058 byte response starts "<!doctype html>
<!-- tfl-probe -->
<!--[if IE 7]>         <html lang="en" class="no-js lt-ie10 lt-ie9 lt-
ie8"> <![endif]-->
<!--[if IE 8]>         <html lang="en" class="no-js lt-ie10 lt-ie9">
<![endif]-->
<!--[if IE 9]>         <html lang="en" class=""
accesses=10, index=8, ElapsedTime=9684, "https://tfl.gov.uk/bus/stop/490
008376N/horse-guards-parade" Is 196296 bytes, starting "<!doctype html>"
Elapsed=9698, asynchronous is True, threads = 10

This with XMLHttpManager.synchronous = False: XMLHttpManager.threads = 3

accesses=3, index=0, ElapsedTime=606, "https://tfl.gov.uk/bus/stop/49000
0014B/barbican-station" Is 120203 bytes, starting "<!doctype html>"
accesses=4, index=2, ElapsedTime=1413, "https://tfl.gov.uk/bus/stop/4900
04202W/bouverie-road" Is 121082 bytes, starting "<!doctype html>"
accesses=5, index=0, ElapsedTime=1212, "https://tfl.gov.uk/bus/stop/4900
05357N/clarendon-road" Is 118297 bytes, starting "<!doctype html>"
accesses=6, index=2, ElapsedTime=812, "https://tfl.gov.uk/bus/stop/49000
6295D/chaplin-road" Is 133137 bytes, starting "<!doctype html>"
accesses=7, index=0, ElapsedTime=1314, "https://tfl.gov.uk/bus/stop/4900
06646N/essex-road-south" Is 110860 bytes, starting "<!doctype html>"
accesses=8, index=1, ElapsedTime=4050, "https://tfl.gov.uk/bus/stop/4900
04005S/billingsgate-market" Is 106342 bytes, starting "<!doctype html>"
accesses=9, index=2, ElapsedTime=1923, "https://tfl.gov.uk/bus/stop/4900
06722S/falcon-grove" Is 134923 bytes, starting "<!doctype html>"
accesses=10, index=0, ElapsedTime=3825, "https://tfl.gov.uk/bus/stop/490
007971E/hornsey-road" Is 121785 bytes, starting "<!doctype html>"
accesses=10, index=2, ElapsedTime=2911, Status=404, statusText=Not
Found, 82058 byte response starts "<!doctype html>
<!-- tfl-probe -->
<!--[if IE 7]>         <html lang="en" class="no-js lt-ie10 lt-ie9 lt-
ie8"> <![endif]-->
<!--[if IE 8]>         <html lang="en" class="no-js lt-ie10 lt-ie9">
<![endif]-->
<!--[if IE 9]>         <html lang="en" class=""
accesses=10, index=1, ElapsedTime=3831, "https://tfl.gov.uk/bus/stop/490
008376N/horse-guards-parade" Is 189382 bytes, starting "<!doctype html>"
Elapsed=7897, asynchronous is True, threads = 10

I am not completely happy with the code. I REALLY don't like the sleep
loops, but don't know how to generate an event when a read completes.
-- 
Walter Briscoe

[toc] | [next] | [standalone]

#109788

Walter,
This is beyond the scope of most VBAers and more within the scope of 
VBers. There are some here that, like me, do VB6 development but they 
ask these sort of advanced programming Qs in a Classic VB forum such as 
those under my signature...

-- 
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
  comp.lang.basic.visual.misc
  microsoft.public.vb.general.discussion

[toc] | [prev] | [standalone]

Back to top | Article view | microsoft.public.excel.programming

csiph-web