Solved

Best way to parse out a json string in VB6?

Posted on 2016-10-09
10
116 Views
Last Modified: 2016-11-18
I'm currently calling a web service that is providing a json feed using VB6. What is the best way to parse the information. I currently have the string being returned which I am dumping to a rich text box and formatting for test purposes, but would like to know what the best recommended way of parsing the variable names, and data out.

Is it best to simple runs through and parsing it as a string, using pointers and counters etc... to determine the various sections, or is there a pre-written function somewhere that makes the task slightly less cumbersome? Any thoughts would be good, not after a complete guide.

A sample of the receiving string is as follows:
{
  "section":[
    {
      "client_id":"1124290",
      "m_code_4char":"JCOL",
      "venue":"Johnny Collingworth",
      "updated_ts":null,
      "invoices":[
        {
          "no":100,
          "description":"Fees - Jan",
          "value":300.50,
          "reduction":0,
          "updated_ts":null
        },
        {
          "no":101,
          "description":"Fees - Feb",
          "value":450.00,
          "reduction":0,
          "updated_ts":null
        },
        {
          "no":102,
          "description":"Fees - Mar",
          "value":125.00,
          "reduction":0,
          "updated_ts":null
        },
        {
          "no":103,
          "description":"Fees - Apr",
          "value":87.50,
          "reduction":0,
          "updated_ts":null
        },
        {
          "no":104,
          "description":"Fees - May",
          "value":786.00,
          "reduction":0,
          "updated_ts":null
        },
      ],
      "client_ReductionFactor":0
    },
    {
      "client_id":"1124291",
      "m_code_4char":"JSMI",
      "venue":"Johnny Smith",
      "updated_ts":null,
      "invoices":[
        {
          "no":105,
          "description":"Fees - Jan",
          "value":300.50,
          "reduction":0,
          "updated_ts":null
        },
        {
          "no":106,
          "description":"Fees - Feb",
          "value":450.00,
          "reduction":0,
          "updated_ts":null
        },
        {
          "no":107,
          "description":"Fees - Mar",
          "value":125.00,
          "reduction":0,
          "updated_ts":null
        },
        {
          "no":108,
          "description":"Fees - Apr",
          "value":87.50,
          "reduction":0,
          "updated_ts":null
        },
        {
          "no":109,
          "description":"Fees - May",
          "value":786.00,
          "reduction":0,
          "updated_ts":null
        },
      ],

      "creditnotes":[
        {
          "no":10035,
          "description":"Fees - Jan",
          "value":-75.00,
          "updated_ts":null
        },
        {
          "no":10036,
          "description":"Fees - Feb",
          "value":-45,
          "updated_ts":null
        },
      ],
      "client_ReductionFactor":0
    },
  ],
  "feed_version":1.09,
  "server_ts":0
}

Open in new window

0
Comment
Question by:pnclick
  • 2
  • 2
  • 2
  • +1
10 Comments
 
LVL 24

Expert Comment

by:Pawan Kumar
ID: 41836324
Pls try this..

install-package Newtonsoft.json
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq

Dim jsonString As String = getresponseFromtheServer
    Dim jsonObject As JObject = JObject.Parse(jsonString)
    Dim ListItems As List(Of JToken) = jsonObject.Children().ToList
    
	Dim outputCols AS String = ""
	
    For Each items As JProperty In ListItems
        
		item.CreateReader()
		
        Select Case items.Name
            Case "Pawan"
                outputCols += "Pawan:" + vbCrLf
				
                For Each Pawan As JObject In items.Values
                    
					Dim u As String = Pawan("Details")
                    ....................
					
                Next

        End Select
    Next

Open in new window



Also look at this blog post -  

http://www.newtonsoft.com/json/help/html/Introduction.htm
0
 

Author Comment

by:pnclick
ID: 41836336
Thanks Pawan,

This would be for the .NET environment wouldn't it? The software I'm modifying is classic VB6.
0
 
LVL 24

Expert Comment

by:Pawan Kumar
ID: 41836339
No the code is for VB6. Pls Try it out.
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:pnclick
ID: 41836340
Thanks, I'll try now.
0
 
LVL 49

Assisted Solution

by:Ryan Chong
Ryan Chong earned 250 total points
ID: 41836367
you can also try adapt to this class written for asp, which it should work well in VB6 (with/without minor customization)

aspJSON
https://github.com/rcdmk/aspJSON
0
 
LVL 45

Accepted Solution

by:
aikimark earned 250 total points
ID: 41840235
This isn't perfect, but it does parse the JSON you posted and returns an object that you can traverse.  All of the routines are in a .bas file in the github repository (see below).
Public Function parseJSON(parmJSON As String) As Object

    Dim oRE As Object
    Dim oRE_object As Object
    Dim oRE_list As Object
    Dim oMatches As Object
    Dim oM As Object
    Dim oSM As Object
    Dim lngM As Long
    Dim lngSM As Long
    Dim vItem As Variant
    
    Dim colMatchFirstIndexes As New Collection
    
    Dim strText As String
    
    Dim colStack As New Collection
    Dim oCurrentObject As Object
    Dim strToStype As String
    
    Dim strSectionText As String
    Const cStateChars As String = "[{}]"
    Dim vStateNames As Variant
    vStateNames = Array("StartOfList", "StartOfObject", "EndOfObject", "EndOfList")
    Dim lngDepth As Long
    
    strText = Trim(parmJSON)
    
    Set oRE_list = CreateObject("vbscript.regexp")
    oRE_list.Global = True
    oRE_list.Pattern = "(""((?:.|\"")+?)"")|([^ ,]+?)(?:,| |$)"
    Set oRE_object = CreateObject("vbscript.regexp")
    oRE_object.Global = True
    oRE_object.Pattern = """([^""]+)"": ?((""((?:\\""|.)+?)"")|([^ ,]*?))(?:,| |$)"
    Set oRE = CreateObject("vbscript.regexp")
    oRE.Global = True
    
    'preprocess the matches to ignore the escaped major delimiters
    oRE.Pattern = "(\\\[|\\{|\\}|\\\])" ' "(\[|{|}|\])"      '"(\[|{|: |}|\])"
    If oRE.test(strText) Then
        oRE.Pattern = "(\\\[|\\{|\\}|\\\]|\[|{|}|\])" ' "(\[|{|}|\])"      '"(\[|{|: |}|\])"
        Set oMatches = oRE.Execute(strText)
        For Each oM In oMatches
            If Len(oM) = 1 Then
                colMatchFirstIndexes.Add oM.firstindex + 1
            Else
                'Debug.Print oM.firstindex + 1, oM, "Skipped major delimiter"
            End If
        Next
    Else
        oRE.Pattern = "(\[|{|}|\])"       '"(\[|{|: |}|\])"
        Set oMatches = oRE.Execute(strText)
        For Each oM In oMatches
            colMatchFirstIndexes.Add oM.firstindex + 1
        Next
    End If
    Select Case True
        Case colMatchFirstIndexes.Count = 0
            MsgBox "no major delimiters, [|{|}|] , found", vbCritical
            Exit Function
        Case (colMatchFirstIndexes.Count Mod 2) <> 0
            MsgBox "odd number of major delimiters, [|{|}|] , found", vbCritical
            Exit Function
    End Select
    oRE.Pattern = "([\r\n])"
    For lngM = 1 To colMatchFirstIndexes.Count - 1
        Select Case InStr(cStateChars, Mid(strText, colMatchFirstIndexes(lngM), 1))
            Case 1  '[ -- start of list
                lngDepth = lngDepth + 1
                If oCurrentObject Is Nothing Then
                    Set oCurrentObject = New Collection
                    'Debug.Print "current object type: " & TypeName(oCurrentObject), "Stack size: " & colStack.Count
                Else
                    'push dicCurrentObject onto the stack
                    PushObjectOntoStack oCurrentObject, colStack
                    'create a new collection object
                    Set oCurrentObject = New Collection
                End If
            
            Case 2  '{ -- start of object
                lngDepth = lngDepth + 1
                If oCurrentObject Is Nothing Then
                    Set oCurrentObject = CreateObject("scripting.dictionary")
                    'Debug.Print "current object type: " & TypeName(oCurrentObject), "Stack size: " & colStack.Count
                Else
                    'push dicCurrentObject onto the stack
                    PushObjectOntoStack oCurrentObject, colStack
                    'create a new dictionary Object
                    Set oCurrentObject = CreateObject("scripting.dictionary")
                End If
            
            Case 3, 4   '} or ] -- end of object or list
                lngDepth = lngDepth - 1
                'add current object to top of stack object
                Set oCurrentObject = AddCurrentObjectToTopOfStackObject(oCurrentObject, colStack)

        End Select
        
        strSectionText = Mid(strText, colMatchFirstIndexes(lngM), colMatchFirstIndexes(lngM + 1) - colMatchFirstIndexes(lngM))
        strSectionText = Trim(Mid(oRE.Replace(strSectionText, ""), 2)) & " "
        Select Case TypeName(oCurrentObject)
            Case "Dictionary"
                Set oMatches = oRE_object.Execute(strSectionText)
            Case "Collection"
                Set oMatches = oRE_list.Execute(strSectionText)
        End Select
        
'        If colStack.Count = 0 Then
'            strToStype = "n/a"
'        Else
'            strToStype = TypeName(colStack(1))
'        End If
'        Debug.Print "current object type: " & TypeName(oCurrentObject), "Stack size: " & colStack.Count, "ToS object type: " & strToStype, "omatches.count: " & oMatches.Count, strSectionText
        If oMatches.Count <> 0 Then
            PopulateCurrentObject oMatches, oCurrentObject
        End If
    Next
    Set parseJSON = oCurrentObject
End Function

Open in new window

I put this module in a github repository: https://github.com/aikimark/ParseJSON
It needs some work.

The returned object is a dictionary with three keys ("section", "feed_version", "server_ts").
The "section" object is a collection containing two dictionary objects.
Each of the "section" dictionary objects contains six keys ("client_id", "m_code_4char", "venue", "updated_ts", "invoices", "client_ReductionFactor")
These data types are:
client_id     String
m_code_4char  String
venue         String
updated_ts    Null
invoices      Collection
creditnotes   Collection
client_ReductionFactor      Double

Open in new window

Notice that the "invoices" and "creditnotes" items are collections of objects.  You can explore these and lower level items as you play with the code.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41860604
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

867 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now