Hi
There is 2 issues in JSON Reader
- when parsing an empty JSON Object ( i.e. "acl" : {} )
- when parsin an javascript var ( i.e. "parent" : Ext.nd.Session )
to resolve this I modified JSONReader.ParseMe, JSONReader.SkipWhietSpace, JSONReader.CreateJSONObject and add JSONReader.CreateJSONVar and a new class JSONVar.
Because of my own framework DOO! (formerly DOOF) and to make integration simplier, I prefixed your classes by "SNAPPS_".
BR
' Class SNAPPS_JSONVar
' Description: Comments for Class SNAPPS_JSONVar
' @created Apr 10, 2012
' @author Benoit De-Tarade-External/TECHNIP
' @version : 1.0.0
Class SNAPPS_JSONVar
Private §JSONName As String
' Sub New
' Description: Comments for Sub New
' @created Apr 10, 2012
' @author Benoit De-Tarade-External/TECHNIP
' @version 1.0.0
' @param
' @throws
Public Sub New (varname As String)
Me.§JSONName = varname
End Sub
' Property Get JSONName
' Description: Comments for Property Get JSONName
' @created Apr 10, 2012
' @author Benoit De-Tarade-External/TECHNIP
' @version 1.0.0
' @return String
' @param
' @throws
Public Property Get JSONName As String
JSONName = Me.§JSONName
End Property
End Class
Class SNAPPS_JSONReader
'*********************************************************************************************
'* Version: 1.0.6
'* Purpose: This class provides a way to parse JSON text into either a
'* JSONObject or JSONArray object or some combination. However,
'* it will always return some type of object (if the JSON is valid).
'* Both the JSONObject and JSONArray classes have an Items property.
'* You can put the value of the returned object Items property into a variant
'* then step through the results.
'*
'* This class uses the ls.class.JSONArray and ls.class.JSONObject classes.
'*
'* Example:
'* dim sJSON as String
'* dim jsonReader as JSONReader
'* dim vResults as Variant
'* dim vPieces as Variant
'* set jsonReader = New JSONReader
'* sJSON = |{"a":[15,25],"b":"Some text"}|
'* vResults = jsonReader.Parse(sJSON) 'this is a JSONObject
'* vPieces = vResults.Items
'*
'* Methods: Parse(JSON string)
'*
'* Author: Troy Reimer (treimer@snapps.com)
'*********************************************************************************************
Private m_sJSON As String 'the original string
Private m_iIndex As Long 'the current character index
Private m_iPrevIndex As Long 'the previous character index
Private m_iLen As Long 'the current string length
Private m_iOrigLen As Long 'the original string length
Private m_sChar As String 'the current character
Private m_sPrev As String 'the previous character
Private m_sWorking As String 'the remaining string
Private m_vToken As Variant 'the current token value
Private m_sEscapes List As String 'a list of escape characters
Private m_bHasOperator As Boolean 'flag indicating a number has an operator
'like a date (1/27/2009)
Private OBJECT_END As SNAPPS_ObjectEnd
Private ARRAY_END As SNAPPS_ArrayEnd
Private COLON As SNAPPS_Colon
Private COMMA As SNAPPS_Comma
Private m_sThreadList List As String
Private m_sErrorMessage As String
Private m_iErrorCount As Integer
Private m_sDecimalSeparator As String ' The decimal separator used on the system
Public Sub New
Set OBJECT_END = New SNAPPS_ObjectEnd
Set ARRAY_END = New SNAPPS_ArrayEnd
Set COLON = New SNAPPS_Colon
Set COMMA = New SNAPPS_Comma
Me.m_sEscapes(|"|) = |"|
Me.m_sEscapes(|\|) = |\|
Me.m_sEscapes(|/|) = |/|
Me.m_sEscapes(|b|) = Chr(8)
Me.m_sEscapes(|f|) = Chr(12)
Me.m_sEscapes(|n|) = Chr(10)
Me.m_sEscapes(|r|) = Chr(13)
Me.m_sEscapes(|t|) = Chr(9)
Me.m_sDecimalSeparator = Left(Cstr(Fraction(0.1)), 1)
End Sub
'*********************************************************************************************
'* Purpose: This is the only public method for this class. It returns an object
'* created from parsing the input JSON string.
'*
'* Input: p_sJSON: The JSON string to parse
'*
'* Output: Either a JSONArray or JSONObject or combination
'*
'* Calls: ParseMe
'*********************************************************************************************
Public Function Parse(p_sJSON As String) As Variant
Dim sFirstChar As String
Dim sLastChar As String
On Error Goto ErrorHandler
Me.m_sJSON = Trim(p_sJSON)
Me.m_iIndex = 0
Me.m_iPrevIndex = -1
Me.m_iLen = Len(Me.m_sJSON)
Me.m_iOrigLen = Len(Me.m_sJSON)
Me.m_sWorking = Me.m_sJSON
Me.m_sChar = Left(Me.m_sWorking, 1)
sFirstChar = Left(Me.m_sJSON, 1)
sLastChar = Right(Me.m_sJSON, 1)
If (sFirstChar = "[" And sLastChar = "]") Or (sFirstChar = "{" And sLastChar = "}") Then
Set Parse = Me.ParseMe
Else
Set Parse = Nothing
Error 1000, SNAPPS_ERR_INVALID_JSON
End If
Done:
Exit Function
ErrorHandler:
Call Me.RaiseError(Error$ & " Context: " & SNAPPS_ERR_CURRENT_CHAR & "'" & Me.m_sChar & "'; " & _
SNAPPS_ERR_PREVIOUS_CHAR & "'" & Me.m_sChar & "'; " & _
SNAPPS_ERR_REMAINING_STRING & "'" & Me.m_sWorking & "'")
End Function
'*********************************************************************************************
'* Purpose: This function moves to the next character in the remaining string
'* and returns either a new JSONObject/ JSONArray or the value of the
'* current token.
'*
'* Output: An object or value for the current token
'*
'* Calls: CreateJSONArray
'* CreateJSONObject
'* GetNext
'* GetNumericValue
'* GetPrevious
'* GetStringValue
'* SkipWhiteSpace
'*********************************************************************************************
Private Function ParseMe As Variant
Dim sChar As String
On Error Goto ErrorHandler
Call Me.SkipWhiteSpace
sChar = Me.m_sChar
Call Me.GetNext
If Me.m_iIndex <> Me.m_iPrevIndex Then 'check to make sure we are not in a loop
Me.m_iPrevIndex = Me.m_iIndex
Select Case sChar
Case |{| 'begin object
Set Me.m_vToken = Me.CreateJSONObject
Case |}| 'end object
Set Me.m_vToken = Me.OBJECT_END
Case |[| 'begin array
Set Me.m_vToken = Me.CreateJSONArray
Case |]| 'end array
Set Me.m_vToken = Me.ARRAY_END
Case |"| 'string
Me.m_vToken = Me.GetStringValue
Case |,| 'comma
Set Me.m_vToken = Me.COMMA
Case |:| 'colon
Set Me.m_vToken = Me.COLON
Case |t| 'true
Call Me.MoveNextN(3)
Me.m_vToken = True
Case |f| 'false
Call Me.MoveNextN(4)
Me.m_vToken = False
Case |n| 'null
Call Me.MoveNextN(3)
Me.m_vToken = Null
Case Else 'probably a numeric value
Call Me.GetPrevious
If Isnumeric(Me.m_sChar) Or Me.m_sChar = "-" Then
'this is a number
Me.m_vToken = Me.GetNumericValue
Else
Set Me.m_vToken = Me.CreateJSONVar()
End If
End Select
If Isobject(Me.m_vToken) Then
Set ParseMe = Me.m_vToken
Else
ParseMe = Me.m_vToken
End If
Else
'error we are in a loop
Error 1000, SNAPPS_ERR_INFINITE_LOOP
End If
Done:
Exit Function
ErrorHandler:
Call Me.RaiseError(Error)
End Function
'*********************************************************************************************
'* Purpose: This function creates and populates a JSONArray object with all of its
'* values.
'*
'* Output: A poplated JSONArray object
'*
'* Calls: ParseMe
'* SkipWhiteSpace
'*********************************************************************************************
Private Function CreateJSONArray As SNAPPS_JSONArray
Dim jsonArray As SNAPPS_JSONArray
Dim vValue As Variant
On Error Goto ErrorHandler
Set jsonArray = New SNAPPS_JSONArray
Call Me.SkipWhiteSpace
If Me.m_sChar = "{" Or Me.m_sChar = "[" Or Me.m_sChar = "]" Then
'value is an object
Set vValue = Me.ParseMe
Else
vValue = Me.ParseMe
End If
While Typename(Me.m_vToken) <> "SNAPPS_ARRAYEND"
Call jsonArray.AddItem(vValue)
If Typename(Me.ParseMe) = "SNAPPS_COMMA" Then
Call Me.SkipWhiteSpace
If Me.m_sChar = "{" Or Me.m_sChar = "[" Then
Set vValue = Me.ParseMe
Else
vValue = Me.ParseMe
End If
End If
Wend
Set CreateJSONArray = jsonArray
Done:
Exit Function
ErrorHandler:
Call Me.RaiseError(Error)
End Function
'*********************************************************************************************
'* Purpose: This function creates and populates a JSONObject object with all of its
'* values.
'*
'* Output: A poplated JSONObject object
'*
'* Calls: ParseMe
'* SkipWhiteSpace
'*********************************************************************************************
Private Function CreateJSONObject As SNAPPS_JSONObject
Dim jsonObject As SNAPPS_JSONObject
Dim vKey As Variant
On Error Goto ErrorHandler
Set jsonObject = New SNAPPS_JSONObject
Call Me.SkipWhiteSpace
Me.ParseMe
While TypeName(Me.m_vToken) <> "SNAPPS_OBJECTEND"
If IsObject(Me.m_vToken) Then
vKey = ""
Else
vKey = Me.m_vToken
End If
Call Me.ParseMe 'this character should be a colon
If TypeName(Me.m_vToken) <> "SNAPPS_OBJECTEND" Then
Call jsonObject.AddItem(CStr(vKey), Me.ParseMe)
If TypeName(Me.ParseMe) = "SNAPPS_COMMA" Then
vKey = Me.ParseMe
End If
End If
Wend
Set CreateJSONObject = jsonObject
Done:
Exit Function
ErrorHandler:
Call Me.RaiseError(Error)
End Function
' Function CharIsVar
' Description: Comments for Function CharIsVar
' @created Apr 10, 2012
' @author Benoit De-Tarade-External/TECHNIP
' @version 1.0.0
' @return Variant
' @param
' @throws
Private Function CharIsVar(sChar As String) As Boolean
On Error GoTo ErrorHandler
Dim ascChar As Long
ascChar = Asc(sChar)
' 0 to 9 or
' ( A to Z ) or (a to z) or
' . or _
CharIsVar = (ascchar > 47 And ascchar < 58 ) Or _
(ascchar > 64 And ascchar < 91 ) Or (ascchar > 96 And ascchar < 123 ) Or _
ascChar = 46 Or ascChar = 95
Done:
Exit Function
ErrorHandler:
Call Me.RaiseError(Error)
End Function
' Function CreateJSONVar
' Description: Comments for Function CreateJSONVar
' @created Apr 10, 2012
' @author Benoit De-Tarade-External/TECHNIP
' @version 1.0.0
' @return SNAPPS_JSONVar
' @param
' @throws
Private Function CreateJSONVar As SNAPPS_JSONVar
On Error GoTo ErrorHandler
Dim sReturn As String
Dim sUnicode As String
Dim vEval As Variant
Dim x As Integer
Dim ascSChar As Integer
On Error GoTo ErrorHandler
ascSChar = Asc(Me.m_sChar)
While CharIsVar(Me.m_sChar)
sReturn = sReturn & Me.m_sChar
Call Me.GetNext
Wend
Call Me.GetNext
Set CreateJSONVar = New SNAPPS_JSONVar(sReturn)
Done:
Exit Function
ErrorHandler:
Call Me.RaiseError(Error)
End Function
'*********************************************************************************************
'* Purpose: This function walks the remaining string until a non-numeric value
'* is found. It returns the digits found.
'*
'* Output: A string of digits
'*
'* Calls: GetNext
'*********************************************************************************************
Private Function GetDigits As String
Dim sReturn As String
On Error Goto ErrorHandler
While Isnumeric(Me.m_sChar) Or Me.m_sChar = "+" Or Me.m_sChar = "-" Or Me.m_sChar = "*" Or Me.m_sChar = "/"
If Me.m_sChar = "+" Or Me.m_sChar = "-" Or Me.m_sChar = "*" Or Me.m_sChar = "/" Then
Me.m_bHasOperator = True
End If
sReturn = sReturn & Me.m_sChar
Call Me.GetNext
Wend
GetDigits = sReturn
Done:
Exit Function
ErrorHandler:
Call Me.RaiseError(Error)
End Function
'*********************************************************************************************
'* Purpose: This function moves the "pointer" to the next character in the string.
'*
'* Output: The next character in the string
'*********************************************************************************************
Private Function GetNext As String
On Error Goto ErrorHandler
Me.m_iLen = Me.m_iLen - 1
Me.m_iIndex = Me.m_iIndex + 1
If Me.m_iLen < 0 Then
'for some reason we are trying to move past the last character.
Error 1000, SNAPPS_ERR_MOVE_PAST_LAST
End If
If Me.m_iIndex > Me.m_iOrigLen Then
Me.m_iIndex = Me.m_iOrigLen
End If
Me.m_sPrev = Left(Me.m_sWorking, 1)
Me.m_sWorking = Right(Me.m_sWorking, Me.m_iLen)
Me.m_sChar = Left(Me.m_sWorking, 1)
GetNext = Me.m_sChar
Done:
Exit Function
ErrorHandler:
Call Me.RaiseError(Error)
End Function
'*********************************************************************************************
'* Purpose: This function returns either a Long or Double value for the numeric
'* string being parsed.
'*
'* Output: Long or Double number
'*
'* Calls: GetDigits
'* GetNext
'*********************************************************************************************
Private Function GetNumericValue As Variant
Dim sReturn As String
Dim bIsFloatingPoint As Boolean
Dim vEval As Variant
On Error Goto ErrorHandler
Me.m_bHasOperator = False
sReturn = Me.m_sChar
Call Me.GetNext
sReturn = sReturn & GetDigits
If Me.m_bHasOperator Then
vEval = Evaluate(sReturn)
sReturn = Cstr(vEval(0))
bIsFloatingPoint = True
Else
'check to see if this is a floating point number
If Me.m_sChar = "." Then
sReturn = sReturn & Me.m_sChar
Call Me.GetNext
sReturn = sReturn & GetDigits
bIsFloatingPoint = True
End If
If Lcase(Me.m_sChar) = "e" Then
sReturn = sReturn & Me.m_sChar
Call Me.GetNext
If Me.m_sChar = "+" Or Me.m_sChar = "-" Then
sReturn = sReturn & Me.m_sChar
Call Me.GetNext
sReturn = sReturn & GetDigits
End If
bIsFloatingPoint = True
End If
End If
'return either a double or long value
If bIsFloatingPoint Then
'convert to the current locale
sReturn = Join(Split(Cstr(sReturn), "."), Me.m_sDecimalSeparator)
GetNumericValue = Cdbl(sReturn)
Else
GetNumericValue = Clng(sReturn)
End If
Done:
Exit Function
ErrorHandler:
Call Me.RaiseError(Error)
End Function
'*********************************************************************************************
'* Purpose: This function moves the "pointer" to the previous character in the string.
'*
'* Output: The previous character in the string
'*********************************************************************************************
Private Function GetPrevious As String
On Error Goto ErrorHandler
Me.m_iLen = Me.m_iLen + 1
Me.m_iIndex = Me.m_iIndex - 1
If Me.m_iLen > Me.m_iOrigLen Then
Me.m_iLen = Me.m_iOrigLen
End If
If Me.m_iIndex < 0 Then
'for some reason we are trying to move past the first character.
Error 1000, SNAPPS_ERR_MOVE_PAST_FIRST
End If
Me.m_sWorking = Me.m_sPrev & Me.m_sWorking
Me.m_sChar = Left(Me.m_sWorking, 1)
Me.m_sPrev = Mid(Me.m_sJSON, Me.m_iIndex, 1)
GetPrevious = Me.m_sChar
Done:
Exit Function
ErrorHandler:
Call Me.RaiseError(Error)
End Function
'*********************************************************************************************
'* Purpose: This function returns the string value contained within quotes.
'* It also accounts for unicode characters and escape characters.
'*
'* Output: The string value
'*
'* Calls: GetNext
'* GetPrevious
'*********************************************************************************************
Private Function GetStringValue As String
Dim sReturn As String
Dim sUnicode As String
Dim vEval As Variant
Dim x As Integer
On Error Goto ErrorHandler
While Me.m_sChar <> |"|
If Me.m_sChar = |\| Then
Call Me.GetNext
If Me.m_sChar = "u" Then 'unicode character
sUnicode = ""
For x = 1 To 4 'retrieve the four digit unicode
Call Me.GetNext
If Me.m_sChar = |"| Then
Call Me.GetPrevious
Exit For
Else
sUnicode = sUnicode & Me.m_sChar
End If
Next
sReturn = sReturn & Uchr$("&h" & sUnicode)
Else
'transform if this is an escaped char
If Iselement(Me.m_sEscapes(Me.m_sChar)) Then
sReturn = sReturn & Me.m_sEscapes(Me.m_sChar)
End If
End If
Else
sReturn = sReturn & Me.m_sChar
End If
Call Me.GetNext
Wend
Call Me.GetNext
GetStringValue = sReturn
Done:
Exit Function
ErrorHandler:
Call Me.RaiseError(Error)
End Function
'*********************************************************************************************
'* Purpose: This sub moves the "pointer" the specified number of places.
'*********************************************************************************************
Private Sub MoveNextN(p_iCount As Integer)
Dim x As Integer
On Error Goto ErrorHandler
For x = 1 To p_iCount
Call Me.GetNext
Next
Done:
Exit Sub
ErrorHandler:
Call Me.RaiseError(Error)
End Sub
'*********************************************************************************************
'* Purpose: This function looks at the next character in the string but doesn't move there.
'*
'* Output: The next character in the string.
'*********************************************************************************************
Private Function Peek As String
Peek = Left(Me.m_sWorking, 1)
End Function
'*********************************************************************************************
'* Purpose: This sub moves the "pointer" to the next non-space character.
'*********************************************************************************************
Private Sub SkipWhiteSpace
Dim sPeek As String
Dim aPeek As Integer
On Error Goto ErrorHandler
sPeek = Me.Peek
aPeek = Asc(sPeek)
While sPeek = " " Or aPeek = 10 Or aPeek = 13 Or aPeek = 9
Call Me.GetNext
sPeek = Me.Peek
Wend
Done:
Exit Sub
ErrorHandler:
Call Me.RaiseError(Error)
End Sub
Private Sub RaiseError(p_sMsg As String)
Dim sErrorMsg As String
Dim x As Integer
On Error Goto 0
Me.m_iErrorCount = Me.m_iErrorCount + 1
Me.m_sThreadList(Me.m_iErrorCount) = "<" & Getthreadinfo(10) & ": line " & Erl & ">"
If Me.m_sErrorMessage = "" Then
Me.m_sErrorMessage = "ERROR: " & Err & ": " & p_sMsg & "."
End If
For x = Me.m_iErrorCount To 1 Step -1
sErrorMsg = sErrorMsg & Me.m_sThreadList(x)
Next
sErrorMsg = "<CLASS:" & Typename(Me) & ">" & sErrorMsg & " " & Me.m_sErrorMessage
Error Err, sErrorMsg
End Sub
End Class