Prezados,
Para quem gosta de trabalhar com classes segue aqui outro exemplo feito com classes OOP:
DECLARATION OF JSON
JSON is Class
PUBLIC
CONSTANT
JSON_TYPE_NULL = 0
JSON_TYPE_STRING = 1
JSON_TYPE_NUMERIC = 2
JSON_TYPE_OBJECT = 3
JSON_TYPE_ARRAY = 4
END
PRIVATE
Name is string
Type is int
Value is Variant
OriginalJSON is string
Properties is associative array of JSON dynamic
Items is array of 0 JSON dynamic
IsRoot is boolean
IsParsed is boolean
CONSTANT
JSON_STATE_NONE = 0
JSON_STATE_NAME = 1
JSON_STATE_AFTERNAME = 2
JSON_STATE_VALUE = 3
JSON_SEEK_NONE = 0
JSON_SEEK_STRING = 1
JSON_SEEK_ATOM = 2
JSON_SEEK_OBJECT = 3
JSON_SEEK_ARRAY = 4
JSON_SEEK_ARRAYELEMENT = 5
END
END
CONSTRUCTOR
Procedure Constructor(LOCAL sJSONCode is string = "{}", LOCAL sName is string = "")
WHILE NOT sJSONCode[[1]] _IN_ ("{", "[", """", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "-", "t", "f", "n")
sJSONCode = sJSONCode[[2 TO]]
END
IF sName = "" THEN
:IsRoot = True
END
:Name = sName
:OriginalJSON = NoSpace(sJSONCode)
:IsParsed = True
IF :OriginalJSON _IN_ ("1", "t", "true") THEN
:Type = ::JSON_TYPE_NUMERIC
:Value = 1
ELSE IF :OriginalJSON _IN_ ("0", "f", "false") THEN
:Type = ::JSON_TYPE_NUMERIC
:Value = 0
ELSE IF :OriginalJSON = "null" THEN
:Type = ::JSON_TYPE_NULL
:Value = Null
ELSE
SWITCH :OriginalJSON[[1]]
CASE "{":
:Type = ::JSON_TYPE_OBJECT
:IsParsed = False
:Value = :OriginalJSON[[2 TO Length(:OriginalJSON) - 1]]
IF :OriginalJSON = "{}" THEN
:IsParsed = True
END
CASE "[":
:Type = ::JSON_TYPE_ARRAY
IF :OriginalJSON = "[]" THEN
:IsParsed = True
Properties["count"] = new JSON("0", "count")
ELSE
:IsParsed = False
END
CASE """":
:Type = ::JSON_TYPE_STRING
:Value = :FixString(:OriginalJSON[[2 TO Length(:OriginalJSON) - 1]])
OTHER CASE
:Type = ::JSON_TYPE_NUMERIC
xNumber is numeric = :OriginalJSON
:Value = xNumber
END
END
IF :IsParsed THEN
:OriginalJSON = ""
END
DESTRUCTOR
Procedure Destructor()
:Release()
METHOD PARSE
Procedure PRIVATE Parse()
IF :Type _IN_ (::JSON_TYPE_NULL, ::JSON_TYPE_NUMERIC, ::JSON_TYPE_STRING) THEN
:IsParsed = True
RETURN
END
bToSelf is boolean = False
nState is int = ::JSON_STATE_NONE
nSeek is int = ::JSON_SEEK_NONE
sChar is string = ""
sTokenName is string = ""
sTokenValue is string = ""
sLastToken is string = ""
bAllow is boolean = False
bFinished is boolean = False
nObjOpened is int
nArrOpened is int
bEscapeStr is boolean
bInsideString is boolean
bArrayFinished is boolean
bIsLastChar is boolean
pclItem is JSON dynamic
FOR i = 1 _TO_ Length(:OriginalJSON)
bIsLastChar = i = Length(:OriginalJSON)
sChar = :OriginalJSON[[i]]
bAllow = False
IF nState _IN_ (::JSON_STATE_NONE, ::JSON_STATE_AFTERNAME) THEN
IF NOT sChar _IN_ ("""", "{", "[", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "n", "t", "f", "-") THEN
CONTINUE
END
bEscapeStr = False
bInsideString = False
SWITCH sChar
CASE """":
bToSelf = False
IF nState = ::JSON_STATE_NONE THEN
sTokenName = """"
sTokenValue = ""
nState = ::JSON_STATE_NAME
nSeek = ::JSON_SEEK_STRING
sLastToken = sTokenName
ELSE
sTokenValue = """"
nState = ::JSON_STATE_VALUE
nSeek = ::JSON_SEEK_STRING
sLastToken = sTokenValue
END
bInsideString = True
CASE "{":
IF nState = ::JSON_STATE_NONE THEN
sTokenName = ""
bToSelf = True
END
nState = ::JSON_STATE_VALUE
nSeek = ::JSON_SEEK_OBJECT
sLastToken = ""
nObjOpened = 1
sTokenValue = ""
CASE "[":
IF nState = ::JSON_STATE_NONE THEN
sTokenName = ""
bToSelf = True
END
nState = ::JSON_STATE_VALUE
IF bToSelf THEN
nSeek = ::JSON_SEEK_ARRAYELEMENT
bArrayFinished = False
sTokenValue = ""
ELSE
nSeek = ::JSON_SEEK_ARRAY
sTokenValue = "["
END
sLastToken = ""
nArrOpened = 1
nObjOpened = 0
OTHER CASE
IF nState = ::JSON_STATE_NONE THEN
sTokenName = ""
bToSelf = True
END
sTokenValue = sChar
nState = ::JSON_STATE_VALUE
nSeek = ::JSON_SEEK_ATOM
sLastToken = sTokenValue
END
bFinished = False
IF bIsLastChar THEN
bFinished = True
bArrayFinished = True
sTokenValue = ""
ELSE
CONTINUE
END
END
IF bInsideString THEN
IF sChar = """" _AND_ bEscapeStr = False THEN
bInsideString = False
ELSE IF bEscapeStr = False _AND_ sChar = "\" THEN
IF nSeek <> ::JSON_SEEK_STRING THEN
bEscapeStr = True
END
ELSE IF bEscapeStr THEN
IF nSeek <> ::JSON_SEEK_STRING THEN
bEscapeStr = False
END
END
END
SWITCH nSeek
CASE ::JSON_SEEK_ARRAY:
bAllow = True
IF bInsideString = False THEN
IF sChar = "[" THEN
nArrOpened++
ELSE IF sChar = "]" THEN
nArrOpened
IF nArrOpened = 0 THEN
bAllow = True
bFinished = True
END
END
END
CASE ::JSON_SEEK_ARRAYELEMENT:
bAllow = True
IF bInsideString = False THEN
IF sChar = "[" THEN
nArrOpened++
ELSE IF sChar = "{" THEN
nObjOpened++
ELSE IF sChar = "}" THEN
nObjOpened
ELSE IF sChar = "]" THEN
nArrOpened
IF nObjOpened = 0 AND nArrOpened = 0 THEN
bAllow = False
bFinished = True
bArrayFinished = True
END
END
IF nObjOpened = 0 AND nArrOpened = 1 _AND_ sChar = "," THEN
bAllow = False
bFinished = True
END
END
CASE ::JSON_SEEK_ATOM:
IF Position("truefalsenull0123456789.", sChar) < 1 THEN
bFinished = True
ELSE IF bIsLastChar THEN
bFinished = True
bAllow = True
ELSE
bAllow = True
END
CASE ::JSON_SEEK_OBJECT:
bAllow = True
IF bInsideString = False THEN
IF sChar = "{" THEN
nObjOpened++
ELSE IF sChar = "}" THEN
nObjOpened
IF nObjOpened = 0 THEN
bAllow = False
bFinished = True
END
END
END
CASE ::JSON_SEEK_STRING:
IF bInsideString = False THEN
bAllow = True
bFinished = True
ELSE IF bEscapeStr = False _AND_ sChar = "\" THEN
bAllow = True
bEscapeStr = True
ELSE IF bEscapeStr THEN
IF NOT sChar _IN_ (Charact(13), Charact(10)) THEN
bAllow = True
END
bEscapeStr = False
ELSE
bAllow = True
END
OTHER CASE
END
IF bAllow THEN
IF nState = ::JSON_STATE_NAME THEN
sTokenName += sChar
sLastToken = sTokenName
ELSE IF nState = ::JSON_STATE_VALUE THEN
sTokenValue += sChar
sLastToken = sTokenValue
END
END
IF bFinished THEN
IF nState = ::JSON_STATE_VALUE THEN
IF bToSelf THEN
IF nSeek = ::JSON_SEEK_ARRAYELEMENT THEN
nNextElem is int = ArrayCount(:Items) + 1
pclItem = new JSON(sTokenValue, "[" + nNextElem + "]")
ArrayAdd(:Items, pclItem)
pclItem = :Properties["count"]
IF pclItem = Null THEN
pclItem = new JSON("1", "count")
:Properties["count"] = pclItem
ELSE
pclItem:Value = ArrayCount(:Items)
END
sTokenValue = ""
IF bArrayFinished THEN
nSeek = ::JSON_SEEK_NONE
ELSE
bFinished = False
END
ELSE IF nSeek = ::JSON_SEEK_OBJECT THEN
:OriginalJSON = sTokenValue
:Parse()
RETURN
ELSE
ExceptionThrow(1,"Bad seek for self")
END
ELSE
sItemName is string = sTokenName[[2 TO Length(sTokenName) - 1]]
pclItem = :Properties[sItemName]
IF pclItem <> Null THEN
ExceptionThrow(1,"Repeated property: " + sItemName + " under " + :Name)
END
IF nSeek = ::JSON_SEEK_OBJECT THEN
sTokenValue = "{" + sTokenValue + "}"
END
pclItem = new JSON(sTokenValue, sItemName)
:Properties[sItemName] = pclItem
nState = ::JSON_STATE_NONE
sTokenValue = ""
sTokenName = ""
END
ELSE IF nState = ::JSON_STATE_NAME THEN
nState = ::JSON_STATE_AFTERNAME
sTokenValue = ""
ELSE
ExceptionThrow(1,"Bad state")
END
END
END
:IsParsed = True
:OriginalJSON = ""
METHOD RELEASE
Procedure PRIVATE Release()
sProp is string
pclVal is JSON dynamic
FOR EACH ELEMENT pclVal, sProp OF :Properties
Delete pclVal
END
ArrayDeleteAll(:Properties)
FOR i = 1 _TO_ :Items..Occurrence
pclVal = :Items[i]
Delete pclVal
END
ArrayDeleteAll(:Items)
METHOD READ
Procedure Read(LOCAL sPath is string, *)
LastPart is string
TargetObj is JSON dynamic = SeekBase(sPath, LastPart, MyParameters[2 TO])
IF TargetObj = Null THEN
RESULT Null
END
IF LastPart <> "" THEN
IF IsNumeric(LastPart) THEN
Idx is int = Val(LastPart)
IF Idx > ArrayCount(TargetObj.Items) THEN
ExceptionThrow(1,"Array index overflow, asking for " + Idx + " when i have only " + TargetObj.Items..Occurrence)
END
TargetObj = TargetObj.Items[Idx]
ELSE
TargetObj = TargetObj.Properties[LastPart]
END
END
RESULT TargetObj.Value
METHOD FIXSTRING
Procedure PRIVATE FixString(LOCAL sRawString is string)
sNewString is string = sRawString
vMyVari is Variant
nMy2byte is 2-byte unsigned int
nMyCurPos is int = Position(sNewString,"\u")
WHILE nMyCurPos > 0
sHexVal is string = sNewString[[nMyCurPos + 2 TO nMyCurPos + 5]]
nMy2byte = Val(sHexVal,"x")
vMyVari = nMy2byte
VariantConvert(vMyVari,wlBinaryString)
sMyUnistr is UNICODE string = vMyVari
sMyNormStr is string = UnicodeToAnsi(sMyUnistr)
sNewString = Replace(sNewString, "\u" + sHexVal, sMyNormStr[[1]])
nMyCurPos = Position(sNewString,"\u")
END
sNewString = Replace(sNewString, "\""", """")
sNewString = Replace(sNewString, "\n", CR)
sNewString = Replace(sNewString, "\t", TAB)
sNewString = Replace(sNewString, "\r", Charact(10))
sNewString = Replace(sNewString, "\/", "/")
sNewString = Replace(sNewString, "\b", "")
sNewString = Replace(sNewString, "\f", "")
sNewString = Replace(sNewString, "\\", "\")
RESULT sNewString
METHOD NEWPROPERTY
Procedure NewProperty(LOCAL sPath is string, LOCAL Type is int = JSON_TYPE_OBJECT, vValue = Null, *)
LastPart is string
TargetObj is JSON dynamic = SeekBase(sPath, LastPart, MyParameters[4 TO])
IF TargetObj = Null THEN
ExceptionThrow(1, "Cannot create " + sPath + " because the path does not exists")
END
NewJSONCode is string = "null"
NewObj is JSON dynamic
SWITCH Type
CASE JSON_TYPE_STRING:
NewJSONCode = ToJsonString(vValue)
CASE JSON_TYPE_NUMERIC:
NewJSONCode = vValue
CASE JSON_TYPE_OBJECT:
NewJSONCode = "{}"
IF vValue <> Null THEN
NewObj = vValue
END
CASE JSON_TYPE_ARRAY:
NewJSONCode = "[]"
IF vValue <> Null THEN
NewObj = vValue
END
CASE JSON_TYPE_NULL:
NewJSONCode = "null"
OTHER CASE
ExceptionThrow(1, "Invalid object type")
END
IF NewObj = Null THEN
NewObj = new JSON(NewJSONCode,LastPart)
ELSE
NewObj.Name = LastPart
END
IF IsNumeric(LastPart) THEN
Idx is int = Val(LastPart)
IF Idx > ArrayCount(TargetObj.Items) + 1 THEN
ExceptionThrow(1,"Can only put items on the next available slot, currently i have " + TargetObj.Items..Occurrence + " and you are trying to put it on " + Idx)
END
IF Idx > ArrayCount(TargetObj.Items) THEN
NewPos is int = ArrayAdd(TargetObj.Items, NewObj)
dbgAssert(NewPos = Idx, "Invalid position, something was wrong")
TargetObj.Properties["count"].Value = ArrayCount(TargetObj.Items)
ELSE
PrevObj is JSON dynamic = TargetObj.Items[Idx]
TargetObj.Items[Idx] = NewObj
Delete PrevObj
END
ELSE
PrevProp is JSON dynamic = TargetObj.Properties[LastPart]
TargetObj.Properties[LastPart] = NewObj
IF PrevProp <> Null THEN
Delete PrevProp
END
END
RESULT NewObj
METHOD SEEKBASE
Procedure PROTECTED SeekBase(LOCAL sPath is string, LastProperty, *)
IF NOT :IsParsed THEN
:Parse()
END
IF sPath = "" THEN
RESULT object
END
IF MyParameters..Occurrence > 2 THEN
FOR i = MyParameters..Occurrence _TO_ 3 STEP -1
sPath = Replace(sPath, "%" + (i - 2), MyParameters[i])
END
END
nIdx is int = 0
IF sPath[[1]] = "[" THEN
nCloseBrac is int = Position(sPath, "]")
nIdx = sPath[[2 TO nCloseBrac - 1]]
sPath = sPath[[nCloseBrac + 1 TO]]
IF sPath[[1]] = "." THEN
sPath = sPath[[2 TO]]
END
END
nFirstDot is int = Position(sPath, ".")
nFirstBracket is int = Position(sPath, "[")
nTo is int = nFirstDot
IF nFirstDot < 1 _OR_ (nFirstDot > nFirstBracket _AND_ nFirstBracket > 1) THEN
nTo = nFirstBracket
END
IF nTo < 1 THEN
nTo = Length(sPath)
ELSE
nTo -= 1
END
sFirstPart is string = sPath[[1 TO nTo]]
sLastPart is string = sPath[[nTo + 1 TO]]
IF sLastPart[[1]] = "." THEN
sLastPart = sLastPart[[2 TO]]
END
IF nIdx > 0 THEN
sFirstPart = ""
sLastPart = sPath
END
pclValueToReturn is JSON dynamic
IF sLastPart = "" THEN
IF nIdx > 0 THEN
LastProperty = nIdx
ELSE
LastProperty = sLastPart
END
END
IF nIdx > 0 THEN
IF nIdx > ArrayCount(:Items) THEN
RESULT object
END
pclValueToReturn = :Items[nIdx]
ELSE
pclValueToReturn = :Properties[sFirstPart]
IF pclValueToReturn = Null THEN
LastProperty = sFirstPart
END
END
IF pclValueToReturn = Null THEN
RESULT object
END
RESULT pclValueToReturn:SeekBase(sLastPart, LastProperty)
METHOD TOJSONSTRING
Procedure PRIVATE ToJsonString(LOCAL WindevString is string)
sNewString is string = WindevString
sNewString = Replace(sNewString, """", "\""")
sNewString = Replace(sNewString, CR, "\n")
sNewString = Replace(sNewString, TAB, "\t")
sNewString = Replace(sNewString, Charact(10), "\r")
sNewString = Replace(sNewString, "/", "\/")
sNewString = Replace(sNewString, "", "\b")
sNewString = Replace(sNewString, "", "\f")
sNewString = Replace(sNewString, "\", "\\")
sJSONString is string = ""
FOR i = 1 _TO_ Length(sNewString)
IF NoAccent(sNewString[[i]]) <> sNewString[[i]] THEN
MyUniString is UNICODE string = AnsiToUnicode(sNewString[[i]])
sJSONString += "\u" + NumToString(Asc(MyUniString), "04x")
ELSE
sJSONString += sNewString[[i]]
END
END
RESULT """" + sJSONString + """"
METHOD SERIALIZE
Procedure Serialize()
ToReturn is string = ""
Elements is string = ""
SWITCH Type
CASE JSON_TYPE_ARRAY:
ToReturn += "["
FOR i = 1 _TO_ :Items..Occurrence
IF Elements <> "" THEN
Elements += ","
END
Elements += :Items[i].Serialize()
END
ToReturn += Elements
ToReturn += "]"
CASE JSON_TYPE_NULL:
ToReturn += "null"
CASE JSON_TYPE_NUMERIC:
ToReturn += Value
CASE JSON_TYPE_OBJECT:
ToReturn += "{"
sProp is string
pclVal is JSON dynamic
FOR EACH ELEMENT pclVal, sProp OF :Properties
IF Elements <> "" THEN
Elements += ","
END
Elements += """" + sProp + """:" + pclVal.Serialize()
END
ToReturn += Elements
ToReturn += "}"
CASE JSON_TYPE_STRING:
ToReturn += ToJsonString(Value)
OTHER CASE
ToReturn = ""
END
RESULT ToReturn
DECLARATION OF JSON_RSRenderer
JSON_RSRenderer is Class
END
Constructor
Procedure Constructor()
Destructor
Procedure Destructor()
METHOD JsonDataSource
Procedure GLOBAL JsonDataSource(DataSource, LOCAL Tag is int = -1)
objJson is JSON dynamic = new JSON("[]")
Idx is int = 1
BasePath is string = "[%1]"
Items is string = HListItem(DataSource)
Item is string
FOR EACH DataSource
objJson.NewProperty(BasePath, JSON::JSON_TYPE_OBJECT, Null, Idx)
IF Tag >= 0 THEN
objJson.NewProperty(BasePath + "._tag", JSON::JSON_TYPE_NUMERIC, Tag + Idx - 1, Idx)
END
FOR EACH STRING Item OF Items SEPARATED by CR
ItemName is string = DataSource + "." + Item
objJson.NewProperty(BasePath + "." + Item, ItemType(ItemName), {ItemName, indItem}, Idx)
END
Idx++
END
RESULT objJson
METHOD RenderDataSource
Procedure GLOBAL RenderDataSource(DataSource, LOCAL Tag is int = -1)
resp is JSON()
resp.NewProperty("status",JSON::JSON_TYPE_STRING,"ok")
objJson is JSON dynamic = JsonDataSource(DataSource, Tag)
resp.NewProperty("list",JSON::JSON_TYPE_ARRAY,objJson)
METHOD RenderOk
Procedure GLOBAL RenderOk()
METHOD RenderException
Procedure GLOBAL RenderException()
err is JSON
err.NewProperty("status", JSON::JSON_TYPE_STRING, "error")
err.NewProperty("error", JSON::JSON_TYPE_NUMERIC, ExceptionInfo(errCode))
err.NewProperty("message", JSON::JSON_TYPE_NUMERIC, ExceptionInfo(errMessage))
err.NewProperty("summary", JSON::JSON_TYPE_NUMERIC, ExceptionInfo(errSummary))
METHOD JsonRecord
Procedure GLOBAL JsonRecord(DataSource, LOCAL Tag is int = -1)
objJson is JSON dynamic = new JSON("{}")
Items is string = HListItem(DataSource)
Item is string
IF Tag >= 0 THEN
objJson.NewProperty("_tag", JSON::JSON_TYPE_NUMERIC, Tag)
END
FOR EACH STRING Item OF Items SEPARATED by CR
ItemName is string = DataSource + "." + Item
objJson.NewProperty(Item, ItemType(ItemName), {ItemName, indItem})
END
RESULT objJson
METHOD RenderRecord
Procedure GLOBAL RenderRecord(DataSource, LOCAL Tag is int = -1)
resp is JSON()
resp.NewProperty("status",JSON::JSON_TYPE_STRING,"ok")
objJson is JSON dynamic = JsonRecord(DataSource, Tag)
resp.NewProperty("record",JSON::JSON_TYPE_OBJECT,objJson)
METHOD ItemType
Procedure GLOBAL ItemType(LOCAL ItemName is string)
JsonType is int = JSON::JSON_TYPE_NULL
nType is int = {ItemName, indItem}..Type
SWITCH nType
CASE 14:
JsonType = JSON::JSON_TYPE_STRING
CASE 11:
JsonType = JSON::JSON_TYPE_STRING
CASE 2:
JsonType = JSON::JSON_TYPE_STRING
CASE 17:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 28:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 5:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 27:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 15:
JsonType = JSON::JSON_TYPE_STRING
CASE 3:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 22:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 24:
JsonType = JSON::JSON_TYPE_STRING
CASE 12:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 9:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 6:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 29:
JsonType = JSON::JSON_TYPE_STRING
CASE 20:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 31:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 18:
JsonType = JSON::JSON_TYPE_STRING
CASE 7:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 19:
JsonType = JSON::JSON_TYPE_NUMERIC
OTHER CASE
JsonType = JSON::JSON_TYPE_STRING
END
RESULT JsonType
METHOD JsonObject
Procedure GLOBAL JsonObject(pclObj is object dynamic, LOCAL Tag is int = -1)
objJson is JSON dynamic = new JSON("{}")
IF Tag >= 0 THEN
objJson.NewProperty("_tag", JSON::JSON_TYPE_NUMERIC, Tag)
END
Def is Definition = GetDefinition(pclObj)
nTotProp is int = Def.Variable..Occurrence
pd is Description de Variable
FOR i = 1 _TO_ nTotProp
pd = Def.Variable[i]
::JsonAny(objJson,pd..Name,{"pclObj." + pd..Name})
END
RESULT objJson
METHOD VarType
Procedure GLOBAL VarType(LOCAL nType is int)
JsonType is int = JSON::JSON_TYPE_STRING
SWITCH nType
CASE 14:
JsonType = JSON::JSON_TYPE_STRING
CASE 11:
JsonType = JSON::JSON_TYPE_STRING
CASE 2:
JsonType = JSON::JSON_TYPE_STRING
CASE 17:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 28:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 5:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 27:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 15:
JsonType = JSON::JSON_TYPE_STRING
CASE 3:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 22:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 24:
JsonType = JSON::JSON_TYPE_STRING
CASE 12:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 9:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 6:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 29:
JsonType = JSON::JSON_TYPE_STRING
CASE 20:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 31:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 18:
JsonType = JSON::JSON_TYPE_STRING
CASE 7:
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 19:
JsonType = JSON::JSON_TYPE_NUMERIC
OTHER CASE
JsonType = JSON::JSON_TYPE_STRING
END
RESULT JsonType
METHOD WlType
Procedure GLOBAL WlType(LOCAL nType is int)
JsonType is int = JSON::JSON_TYPE_STRING
SWITCH nType
CASE wlCurrency, wlHandle, wlInt, wlInt_1, ...
wlInt_2, wlInt_4, wlInt_8, wlNumeric, ...
wlReal, wlReal_4, wlReal_8, wlUnsignedInt_1, ...
wlUnsignedInt_2, wlUnsignedInt_4, wlUnsignedInt_8, wlBoolean:
JsonType = JSON::JSON_TYPE_NUMERIC
OTHER CASE
JsonType = JSON::JSON_TYPE_STRING
END
RESULT JsonType
METHOD JsonArray
Procedure GLOBAL JsonArray(ToArray is array dynamic)
objJson is JSON dynamic = new JSON("[]")
FOR i = 1 _TO_ ToArray..Occurrence
::JsonAny(objJson, "[" + i + "]", ToArray[i])
END
RESULT objJson
METHOD JsonAny
Procedure GLOBAL JsonAny(pclObjJson is JSON dynamic, LOCAL sName is string, value)
def is Definition = GetDefinition(value)
IF def = Null THEN
IF IsNumeric(value) THEN
xNum is numeric
def = GetDefinition(xNum)
ELSE
sStr is string
def = GetDefinition(sStr)
END
END
IF def..Type = wlInstance THEN
pclObjJson.NewProperty(sName, JSON::JSON_TYPE_OBJECT, ::JsonObject(value))
ELSE IF def..Type = wlStructure THEN
pclObjJson.NewProperty(sName, JSON::JSON_TYPE_OBJECT, ::JsonStructure(value))
ELSE IF def..Type = wlArray THEN
pclObjJson.NewProperty(sName, JSON::JSON_TYPE_ARRAY, ::JsonArray(value))
ELSE IF def..Type = wlAssociativeArray THEN
pclObjJson.NewProperty(sName, JSON::JSON_TYPE_OBJECT, ::JsonAssociative(value))
ELSE IF def..Type = wlDataSource THEN
pclObjJson.NewProperty(sName, JSON::JSON_TYPE_ARRAY, ::JsonDataSource(value))
ELSE
nType is int = WlType(def..Type)
pclObjJson.NewProperty(sName, nType, value)
END
METHOD JsonStructure
Procedure GLOBAL JsonStructure(pclObj, LOCAL Tag is int = -1)
objJson is JSON dynamic = new JSON("{}")
IF Tag >= 0 THEN
objJson.NewProperty("_tag", JSON::JSON_TYPE_NUMERIC, Tag)
END
Def is Definition = GetDefinition(pclObj)
nTotProp is int = Def.Variable..Occurrence
pd is Description de Variable
FOR i = 1 _TO_ nTotProp
pd = Def.Variable[i]
::JsonAny(objJson,pd..Name,{"pclObj." + pd..Name})
END
RESULT objJson
METHOD RenderArray
Procedure GLOBAL RenderArray(ToArray is array dynamic)
resp is JSON()
resp.NewProperty("status",JSON::JSON_TYPE_STRING,"ok")
objJson is JSON dynamic = JsonArray(ToArray)
resp.NewProperty("list",JSON::JSON_TYPE_ARRAY,objJson)
METHOD RenderObject
Procedure GLOBAL RenderObject(pclObj is object dynamic)
resp is JSON()
resp.NewProperty("status",JSON::JSON_TYPE_STRING,"ok")
objJson is JSON dynamic = JsonObject(pclObj)
resp.NewProperty("record",JSON::JSON_TYPE_OBJECT,objJson)
METHOD JsonAssociative
Procedure GLOBAL JsonAssociative(ToAssoc)
objJson is JSON dynamic = new JSON("{}")
FOR EACH ELEMENT pclOmit, Key OF ToAssoc
::JsonAny(objJson, Key, ToAssoc[Key])
END
RESULT objJson
METHOD RenderAssociative
Procedure GLOBAL RenderAssociative(pclObj)
resp is JSON()
resp.NewProperty("status",JSON::JSON_TYPE_STRING,"ok")
objJson is JSON dynamic = JsonAssociative(pclObj)
resp.NewProperty("record",JSON::JSON_TYPE_OBJECT,objJson)
CASO TENHA SUGESTOES DE MELHORIAS
ENTRE EM CONTATO
--
Adriano José Boller
______________________________________________
Consultor e Representante Oficial da
PcSoft no Brasil
+55 (41) 9949 1800
adrianoboller@gmail.com
skype: adrianoboller
http://wxinformatica.blogspot.com.br/