jsJsonParser.cls

[danoxp]

Omegastripes, thank you for the beta class module parser. I may have a use for it.

I was playing around with the example xlmx included with jsJsonParser.cls and thought I might share.

1. added a 'default member' to the class module just for convenience

Attribute Item_js.VB_UserMemId = 0

... see http://www.cpearson.com/excel/DefaultMember.aspx

2. renamed and added a few properties to more resemble a Scripting.Dictionary

Public Property Get Item_js() ' As JScriptTypeInfo
    Attribute Item_js.VB_UserMemId = 0  'default member of class
    Set Item_js = getProp   'renamed to resemble Dictionary object
End Property

Public Property Get Type_js() ' As JScriptTypeInfo
    Set Type_js = getType
End Property

Public Property Get Keys_js(o) As Variant    '// array of 1. keys of dic or 2. items of Array
    Keys_js = copyDict(o, New Dictionary).Keys
End Property

Public Property Get Count_js(o) As Variant    '// Count of object/Dictionary (works w Array also, but 'length' is faster)
    Count_js = copyDict(o, New Dictionary).Count
End Property

Public Property Get Items_js(o) As Variant    '//items of object to enable a foreach loop
    Items_js = copyDict(o, New Dictionary).Items
End Property

3. experimented with 'test1' to compare different implementation choices

Sub test1()
    
    Dim t As New cTimer
    Debug.Print "Stocks"
    ' downloading
    t.startTimer
    With CreateObject("MSXML2.XMLHTTP.6.0")
        .Open "GET", "https://api.twelvedata.com/stocks", True
        .Send
        Do Until .ReadyState = 4: DoEvents: Loop
        Dim resp
        resp = .ResponseText
    End With
    Debug.Print "Downloading " & t.elapsedEng
    ' parsing
    t.startTimer
    Dim js As jsJsonParser
    Set js = New jsJsonParser
    Dim image
    Set image = js.parseToJs(resp)
    Do
        Select Case True
            Case image Is Nothing
                Debug.Print "Invalid JSON"
            Case IsEmpty(image)
                Debug.Print "empty JSON"
            Case Not js(image, "status") = "ok"
                Debug.Print "Server error"
            Case Not image.hasOwnProperty("data")
                Debug.Print "image has no 'data'"
            Case Else
                Exit Do
        End Select
        Exit Sub
    Loop Until True
    Debug.Print "Parsing " & t.elapsedEng
    
' processing - fastest code
    t.startTimer
    Dim jsItems
    Set jsItems = CallByName(image, "data", VbGet)
    Dim data
    ReDim data(CallByName(jsItems, "length", VbGet) - 1, 1) '// same time as 'getProp', but errors out if Prop doesn't exist
    Dim i As Long
    Dim k   '// jsTypeInfo for .Items_js
    For i = 0 To CallByName(jsItems, "length", VbGet) - 1   'fastest at 100%
        Set k = CallByName(jsItems, i, VbGet)   'fastest at 100%
        data(i, 0) = k.symbol   '// 100% (
        data(i, 1) = k.name     ' ... js(k,"name")
    Next i
    Debug.Print "Processing - Fastest code " & t.elapsedEng
        
' processing - Compact code
    t.startTimer
'        Dim data
    i = 0 'Dim i As Long
'        Dim k   '// jsTypeInfo for each .Items_js
    ReDim data(js(js(image, "data"), "length") - 1, 1)
    For Each k In js.Items_js(js(image, "data"))    '// Items_js more useful w js Object, not Array
        data(i, 0) = k.symbol
        data(i, 1) = k.name
        i = i + 1
    Next k
    Debug.Print "Processing - Compact code " & t.elapsedEng

'// others tried

'       fastest at 100%
''        data(i, 0) = k.symbol   '// 100%

'       2nd fastest at 115%
''        data(i, 0) = CallByName(k, "symbol", VbGet) '// 105% (15 msec) slower than k.symbol
''        data(i, 1) = CallByName(k, "name", VbGet)

'       slowest at 160%
''        data(i, 0) = js(k, "symbol")  '// 140% (80 msec) slower than k.symbol
''        data(i, 1) = js(k, "name")  '// 140% (80 msec) slower than k.symbol
    Set k = Nothing
    Set jsItems = Nothing
    Set image = Nothing
    Set js = Nothing
    
End Sub

[omegastripes]

@danoxp thanx for the input. There are definitely useful points, will commit CallByName() in nearest. I would note that referencing JS object properties in conventional way via dot might not work since JS is case sensitive (e. g. JSON object may contain Name and name props), but VBA fixes all names making case be the same.

[engycz]

Hi @omegastripes @danoxp.
I have one tweak that will speed up JSON parsing 5x.
Freshly created htmlfile COM object doesn't have JSON object for parsing and the parsing is done by calling eval method (https://github.com/douglascrockford/JSON-js/blob/master/json2.js#L515)

If the class initialization is modified like this

Set document = CreateObject("htmlfile")
document.Write "<meta http-equiv=""x-ua-compatible"" content=""IE=9"" />'"

the JSON object is available and the parsing is done natively.

[danoxp]

Please help me understand your tweak by elaborating on your suggestion. I read it to replace the entire Initialization with just two lines:

Private Sub Class_Initialize()
    Set document = CreateObject("htmlfile")
    document.Write "<meta http-equiv=""x-ua-compatible"" content=""IE=9"" />'"
End Sub

However, this errors out on 'jsonParser.parse(sample)' in this call with known good 11.4Mb Json/text sample:

Public Function parseToJs(sample, Optional success) 
''    On Error Resume Next
    Set parseToJs = jsonParser.parse(sample): 'Dim parse  ' keep lower case
    success = Err.Number = 0
    If Not success Then
        Set parseToJs = Nothing
    End If
End Function

What would usage be for inserting 'sample' json/text into 'document'? Is jsonParser.parse necessary?

thanx dano

[engycz]

Sorry, it was not full code of Class_Initialize

Private Sub Class_Initialize()
    Set document = CreateObject("htmlfile")
    document.Write "<meta http-equiv=""x-ua-compatible"" content=""IE=9"" />'"
    With document.parentWindow
        .execScript jsCode()
        Set jsonParser = .JSON
        Set getProp = .getProp
        Set getType = .getType
        Set copyDict = .copyDict
    End With
End Sub

[danoxp]

Brilliant. 6x !

so simple

I'm getting 6x speed up on parsing. Also, getting similar speed up on js coded functions I added to jsJsonParser class that search/traverse the json object. For example, 'nItem' searches entire Json object for 'value' of nth occurrence of a specified 'key'.

thank you for sharing, dano