#INCLUDE "json.bi"
FUNCTION JSON_IsWhiteSpace (Char AS UINTEGER) AS SHORT
SELECT CASE Char
CASE JSON_TOKEN_TAB, JSON_TOKEN_LF, JSON_TOKEN_CR, JSON_TOKEN_SPACE
JSON_IsWhiteSpace = -1
CASE ELSE
JSON_IsWhiteSpace = 0
END SELECT
END FUNCTION
FUNCTION JSON_IsControl (value AS STRING) AS SHORT
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
CASE ELSE
JSON_IsControl = 0
END SELECT
ELSE
JSON_IsControl = 0
END IF
END FUNCTION
SUB JSON_GetValue (BYREF i AS ULONG, Char AS USHORT, 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)) 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
WHILE NOT JSON_IsWhiteSpace(ASC(MID(RawContent, i, 1)))
i += 1
WEND
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 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 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
SUB JSON_ParseObject (oJSON AS JSON_Object, ArrayMembers() AS JSON_Member)
DIM AS ULONG Char, LastOpen, NextClose, NextColon, NextComma
DIM ValueContent AS STRING
'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))
i = NextClose + 1
NextColon = INSTR(i, oJSON.RawContent, CHR(JSON_TOKEN_COLON))
IF NextColon > 0 THEN
oJSON.MemberCount += 1
ArrayMembers(oJSON.MemberCount - 1).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(oJSON.MemberCount - 1).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
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))
i = NextClose + 1
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_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 USHORT
'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 USHORT 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 SHORT IsDigit, IsNegative, IsFraction, HasExponent, ExponentHasSign
DIM AS INTEGER Char, EPos, i
FOR i = 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