#INCLUDE "json.bi"
FUNCTION JSON_IsWhiteSpace(Char AS ULONG) AS LONG
SELECT CASE Char
CASE JSON_TOKEN_TAB, JSON_TOKEN_LF, JSON_TOKEN_CR, JSON_TOKEN_SPACE
JSON_IsWhiteSpace = -1
END SELECT
END FUNCTION
FUNCTION JSON_IsControl(value AS STRING) AS LONG
IF LEFT(value, 1) = CHR(JSON_TOKEN_ESCAPE) THEN
SELECT CASE LCASE(MID(value, 2, 1))
CASE CHR(JSON_TOKEN_DOUBLE_QUOTE), _
CHR(JSON_TOKEN_SLASH), _
CHR(JSON_TOKEN_ESCAPE), _
"b", "f", "n", "r", "t", "u"
JSON_IsControl = -1
END SELECT
END IF
END FUNCTION
SUB JSON_GetValue(BYREF i AS ULONG, Char AS ULONG, RawContent AS STRING, ValueContent AS STRING = "")
DIM AS ULONG LastOpen, NextClose, NextComma
SELECT CASE Char
CASE JSON_TOKEN_DOUBLE_QUOTE
LastOpen = i
DO
NextClose = INSTR(i + 1, RawContent, CHR(JSON_TOKEN_DOUBLE_QUOTE))
IF JSON_IsControl(MID(RawContent, NextClose - 1, 2)) AND NOT JSON_IsControl(MID(RawContent, NextClose - 2, 2)) THEN
'Escaped double-quote
i = NextClose + 1
ELSE
EXIT DO
END IF
LOOP
ValueContent = MID(RawContent, LastOpen, (NextClose - LastOpen) + 1)
i = NextClose + 1
CASE JSON_TOKEN_OBJECT_OPEN
LastOpen = i
DO
NextClose = INSTR(i + 1, RawContent, CHR(JSON_TOKEN_OBJECT_CLOSE))
IF INSTR(MID(RawContent, i + 1, NextClose - i), CHR(JSON_TOKEN_OBJECT_OPEN)) > 0 THEN
i = NextClose
ELSE
EXIT DO
END IF
LOOP
ValueContent = MID(RawContent, LastOpen, (NextClose - LastOpen) + 1)
i = NextClose + 1
CASE JSON_TOKEN_ARRAY_OPEN
IF i = 1 THEN
i += 1
ELSE
LastOpen = i
DO
NextClose = INSTR(i + 1, RawContent, CHR(JSON_TOKEN_ARRAY_CLOSE))
IF INSTR(MID(RawContent, i + 1, NextClose - i), CHR(JSON_TOKEN_ARRAY_OPEN)) > 0 THEN
i = NextClose
ELSE
EXIT DO
END IF
LOOP
ValueContent = MID(RawContent, LastOpen, (NextClose - LastOpen) + 1)
i = NextClose + 1
END IF
CASE ELSE
IF NOT JSON_IsWhiteSpace(Char) THEN
LastOpen = i
DIM NextChar AS ULONG
'On non-enclosed values, look for a comma or a global enclosing token
DO UNTIL JSON_IsWhiteSpace(NextChar) OR NextChar = JSON_TOKEN_COMMA _
OR NextChar = JSON_TOKEN_ARRAY_CLOSE OR NextChar = JSON_TOKEN_OBJECT_CLOSE
i += 1
NextChar = ASC(MID(RawContent, i, 1))
IF NextChar = 0 OR NextChar = JSON_TOKEN_COMMA THEN
i -= 1
EXIT DO
END IF
LOOP
ValueContent = MID(RawContent, LastOpen, i - LastOpen)
i += 1
END IF
END SELECT
END SUB
SUB JSON_ParseArray(ArrayJSON AS JSON_Array, ArrayValues() AS JSON_Value)
DIM AS ULONG ValueCount, LastPos, NextComma
DIM ValueContent AS STRING
FOR i AS ULONG = 1 TO LEN(ArrayJSON.RawContent)
LastPos = i
JSON_GetValue(i, ASC(MID(ArrayJSON.RawContent, i, 1)), ArrayJSON.RawContent, ValueContent)
IF i > LastPos + 1 AND ValueContent <> "" THEN
ValueCount += 1
WITH ArrayValues(ValueCount - 1)
.ValueType = JSON_GetType(ValueContent)
.RawContent = ValueContent
END WITH
WHILE JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, i, 1)))
i += 1
WEND
NextComma = INSTR(i, ArrayJSON.RawContent, CHR(JSON_TOKEN_COMMA))
IF NextComma > 0 THEN
'To be considered as member separator it must be surrounded by whitespaces
IF JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma - 1, 1))) _
AND JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma + 1, 1))) THEN
i = NextComma + 1
END IF
END IF
END IF
NEXT
END SUB
SUB JSON_CountValues(ArrayJSON AS JSON_Array)
DIM AS ULONG LastPos, NextComma
'Reset value count
ArrayJSON.ValueCount = 0
FOR i AS ULONG = 1 TO LEN(ArrayJSON.RawContent)
LastPos = i
JSON_GetValue(i, ASC(MID(ArrayJSON.RawContent, i, 1)), ArrayJSON.RawContent)
IF i > LastPos + 1 THEN
ArrayJSON.ValueCount += 1
WHILE JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, i, 1)))
i += 1
WEND
NextComma = INSTR(i, ArrayJSON.RawContent, CHR(JSON_TOKEN_COMMA))
IF NextComma > 0 THEN
'To be considered as member separator it must be surrounded by whitespaces
IF JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma - 1, 1))) _
AND JSON_IsWhiteSpace(ASC(MID(ArrayJSON.RawContent, NextComma + 1, 1))) THEN
i = NextComma + 1
END IF
END IF
END IF
NEXT
END SUB
FUNCTION JSON_GetValueIndex(ArrayValues() AS JSON_Value, TargetValue AS JSON_Value) AS LONG
DIM Count AS LONG = UBOUND(ArrayValues)
IF Count >= 0 THEN
FOR i AS ULONG = 0 TO Count
IF ArrayValues(i).RawContent = TargetValue.RawContent _
AND ArrayValues(i).ValueType = TargetValue.ValueType THEN
JSON_GetValueIndex = i
EXIT FOR
END IF
IF i = Count THEN
JSON_GetValueIndex = -1
END IF
NEXT
ELSE
JSON_GetValueIndex = Count
END IF
END FUNCTION
SUB JSON_ParseObject(oJSON AS JSON_Object, ArrayMembers() AS JSON_Member)
DIM AS ULONG Char, Count, LastOpen, NextClose, NextColon, NextComma
DIM ValueContent AS STRING
FOR i AS ULONG = 1 TO LEN(oJSON.RawContent)
Char = ASC(MID(oJSON.RawContent, i, 1))
IF Char = JSON_TOKEN_DOUBLE_QUOTE THEN
LastOpen = i
NextClose = INSTR(i + 1, oJSON.RawContent, CHR(JSON_TOKEN_DOUBLE_QUOTE))
IF NextClose THEN
i = NextClose + 1
END IF
NextColon = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COLON))
IF NextColon > 0 THEN
ArrayMembers(Count).Name = MID(oJSON.RawContent, LastOpen + 1, (NextClose - LastOpen) - 1)
i = NextColon + 1
WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
i += 1
WEND
JSON_GetValue (i, ASC(MID(oJSON.RawContent, i, 1)), oJSON.RawContent, ValueContent)
WITH ArrayMembers(Count).Value
.ValueType = JSON_GetType(ValueContent)
.RawContent = ValueContent
END WITH
WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
i += 1
WEND
NextComma = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COMMA))
IF NextComma > 0 THEN
'To be considered as member separator it must be surrounded by whitespaces
IF JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma - 1, 1))) _
AND JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma + 1, 1))) THEN
i = NextComma + 1
END IF
END IF
Count += 1
END IF
END IF
NEXT
END SUB
SUB JSON_CountMembers(oJSON AS JSON_Object)
DIM AS ULONG Char, LastOpen, NextClose, NextColon, NextComma
'Reset Member Count
oJSON.MemberCount = 0
FOR i AS ULONG = 1 TO LEN(oJSON.RawContent)
Char = ASC(MID(oJSON.RawContent, i, 1))
IF Char = JSON_TOKEN_DOUBLE_QUOTE THEN
LastOpen = i
NextClose = INSTR(i + 1, oJSON.RawContent, CHR(JSON_TOKEN_DOUBLE_QUOTE))
IF NextClose THEN
i = NextClose + 1
END IF
NextColon = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COLON))
IF NextColon > 0 THEN
oJSON.MemberCount += 1
i = NextColon + 1
WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
i += 1
WEND
JSON_GetValue (i, ASC(MID(oJSON.RawContent, i, 1)), oJSON.RawContent)
WHILE JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, i, 1)))
i += 1
WEND
NextComma = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COMMA))
IF NextComma > 0 THEN
'To be considered as member separator it must be surrounded by whitespaces
IF JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma - 1, 1))) _
AND JSON_IsWhiteSpace(ASC(MID(oJSON.RawContent, NextComma + 1, 1))) THEN
i = NextComma + 1
END IF
END IF
END IF
END IF
NEXT
END SUB
FUNCTION JSON_GetMemberValue(ArrayMembers() AS JSON_Member, MemberName AS STRING) AS STRING
DIM Count AS LONG = UBOUND(ArrayMembers)
IF Count >= 0 THEN
FOR i AS ULONG = 0 TO Count
WITH ArrayMembers(i)
IF .Name = MemberName THEN
IF .Value.ValueType = JSON_TYPE_STRING THEN
JSON_GetMemberValue = JSON_ParseString(.Value.RawContent)
ELSE
JSON_GetMemberValue = .Value.RawContent
END IF
EXIT FOR
END IF
END WITH
IF i = Count THEN
JSON_GetMemberValue = MemberName
END IF
NEXT
ELSE
JSON_GetMemberValue = MemberName
END IF
END FUNCTION
FUNCTION JSON_GetMemberIndex(ArrayMembers() AS JSON_Member, MemberName AS STRING) AS LONG
DIM Count AS LONG = UBOUND(ArrayMembers)
IF Count >= 0 THEN
FOR i AS ULONG = 0 TO Count
IF ArrayMembers(i).Name = MemberName THEN
JSON_GetMemberIndex = i
EXIT FOR
END IF
IF i = Count THEN
JSON_GetMemberIndex = -1
END IF
NEXT
ELSE
JSON_GetMemberIndex = Count
END IF
END FUNCTION
FUNCTION JSON_ParseString(RawString AS STRING) AS STRING
DIM Char AS ULONG, EscapedChar AS ULONG, Result AS STRING
FOR i AS ULONG = 1 TO LEN(RawString)
Char = ASC(MID(RawString, i, 1))
IF Char = JSON_TOKEN_DOUBLE_QUOTE THEN
IF i = 1 OR i = LEN(RawString) THEN
'Do nothing
END IF
ELSEIF Char = JSON_TOKEN_ESCAPE THEN
EscapedChar = ASC(MID(RawString, i + 1, 1))
SELECT CASE EscapedChar
CASE JSON_TOKEN_DOUBLE_QUOTE, JSON_TOKEN_SLASH, JSON_TOKEN_ESCAPE
Result += CHR(EscapedChar)
CASE ASC("b")
Result += CHR(08)
CASE ASC("f")
Result += CHR(12)
CASE ASC("n")
Result += CHR(JSON_TOKEN_LF)
CASE ASC("r")
Result += CHR(JSON_TOKEN_CR)
CASE ASC("t")
Result += CHR(JSON_TOKEN_TAB)
CASE ASC("u")
Result += CHR(VALINT("&H" + MID(RawString, i + 2, 4)))
i += 4
END SELECT
i += 1
ELSE
Result += CHR(Char)
END IF
NEXT
JSON_ParseString = Result
Result = ""
END FUNCTION
FUNCTION JSON_GetType(value AS STRING) AS ULONG
'Guess the type of the value
SELECT CASE LCASE(value)
CASE "null"
JSON_GetType = JSON_TYPE_NULL
CASE "true", "false"
JSON_GetType = JSON_TYPE_BOOLEAN
CASE ELSE
DIM AS ULONG OpenChar, CloseChar
OpenChar = ASC(LEFT(value, 1))
CloseChar = ASC(RIGHT(value, 1))
IF OpenChar = JSON_TOKEN_DOUBLE_QUOTE AND CloseChar = JSON_TOKEN_DOUBLE_QUOTE THEN
JSON_GetType = JSON_TYPE_STRING
ELSEIF OpenChar = JSON_TOKEN_ARRAY_OPEN AND CloseChar = JSON_TOKEN_ARRAY_CLOSE THEN
JSON_GetType = JSON_TYPE_ARRAY
ELSEIF OpenChar = JSON_TOKEN_OBJECT_OPEN AND CloseChar = JSON_TOKEN_OBJECT_CLOSE THEN
JSON_GetType = JSON_TYPE_OBJECT
ELSE
'Fallback to numeric type
DIM AS LONG IsDigit, IsNegative, IsFraction, HasExponent, ExponentHasSign
DIM AS ULONG Char, EPos
FOR i AS ULONG = 1 TO LEN(value)
Char = ASC(MID(value, i, 1))
SELECT CASE Char
CASE 48 TO 57 'Zero - Onenine
IsDigit = -1
CASE 46 '.
IF IsFraction THEN
IsDigit = 0
ELSE
IsFraction = -1
END IF
CASE 69, 101 'E, e
IF HasExponent THEN
IsDigit = 0
ELSE
HasExponent = -1
EPos = i
END IF
CASE 43, 45 '+, -
IF ExponentHasSign THEN
IsDigit = 0
ELSE
IF HasExponent AND i = EPos + 1 THEN
ExponentHasSign = -1
ELSE
IsDigit = 0
END IF
END IF
IF IsNegative THEN
IsDigit = 0
ELSE
IF i = 1 AND Char = 45 THEN
IsNegative = -1
ELSE
IsDigit = 0
END IF
END IF
CASE ELSE
IsDigit = 0
END SELECT
NEXT
IF IsDigit THEN
JSON_GetType = JSON_TYPE_NUMERIC
ELSE
'All possible types failed, return error
JSON_GetType = JSON_TYPE_ERROR
END IF
END IF
END SELECT
END FUNCTION