Solved

Best way to parse out a json string in VB6?

Posted on 2016-10-09
10
75 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 18

Expert Comment

by:Pawan Kumar Khowal
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 18

Expert Comment

by:Pawan Kumar Khowal
ID: 41836339
No the code is for VB6. Pls Try it out.
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

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

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

744 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

11 Experts available now in Live!

Get 1:1 Help Now