PC SOFT

GRUPOS DE DISCUSSÃO PROFISSIONAL
WINDEVWEBDEV e WINDEV Mobile

Inicio → WINDEV 25 → WX - Trabalhando com arquivos Json
WX - Trabalhando com arquivos Json
Iniciado por adrianoboller, abr., 21 2016 1:40 PM - 9 respostas
Membro registado
3.651 mensagems
Popularité : +175 (223 votes)
Publicado em abril, 21 2016 - 1:40 PM
Prezados,

Hoje vou fazer um passo a passo de como trabalhar com arquivos Json.

Segue exemplo:





Códigos da Procedure JSON_UTIL:

//Global Procedure
GLOBAL
gaaAllowedChars is associative array (WithoutDuplicates,"",wlInt) of string
gaaStateNames is associative array (WithoutDuplicates,"",wlInt) of string

CONSTANT
JSON_SEEK_JSON = 0
JSON_SEEK_TUPLE = 1
JSON_SEEK_TUPLE_SEP = 2
JSON_SEEK_VALUE = 3
JSON_SEEK_ELEMENT_SEP = 4
JSON_SEEK_ELEMENT = 5
JSON_FINISH_KEY = 6
JSON_FINISH_STRING = 7
JSON_FINISH_TRUE = 8
JSON_FINISH_FALSE = 9
JSON_FINISH_NULL = 10
JSON_FINISH_NUMERIC = 11
JSON_FINISH_STRING_ELEM = 12
JSON_FINISH_TRUE_ELEM = 13
JSON_FINISH_FALSE_ELEM = 14
JSON_FINISH_NULL_ELEM = 15
JSON_FINISH_NUMERIC_ELEM = 16
JSON_PARSE_DEBUG = 0
END

gaaStateNames[0] = "JSON_SEEK_JSON"
gaaStateNames[1] = "JSON_SEEK_TUPLE"
gaaStateNames[2] = "JSON_SEEK_TUPLE_SEP"
gaaStateNames[3] = "JSON_SEEK_VALUE"
gaaStateNames[4] = "JSON_SEEK_ELEMENT_SEP"
gaaStateNames[5] = "JSON_SEEK_ELEMENT"
gaaStateNames[6] = "JSON_FINISH_KEY"
gaaStateNames[7] = "JSON_FINISH_STRING"
gaaStateNames[8] = "JSON_FINISH_TRUE"
gaaStateNames[9] = "JSON_FINISH_FALSE"
gaaStateNames[10] = "JSON_FINISH_NULL"
gaaStateNames[11] = "JSON_FINISH_NUMERIC"
gaaStateNames[12] = "JSON_FINISH_STRING_ELEM"
gaaStateNames[13] = "JSON_FINISH_TRUE_ELEM"
gaaStateNames[14] = "JSON_FINISH_FALSE_ELEM"
gaaStateNames[15] = "JSON_FINISH_NULL_ELEM"
gaaStateNames[16] = "JSON_FINISH_NUMERIC_ELEM"

gaaAllowedChars[JSON_SEEK_JSON] = "{["
gaaAllowedChars[JSON_SEEK_TUPLE] = """,}"
gaaAllowedChars[JSON_SEEK_TUPLE_SEP] = ":"
gaaAllowedChars[JSON_SEEK_VALUE] = "tfn0987654321""{["
gaaAllowedChars[JSON_SEEK_ELEMENT_SEP] = ",]"
gaaAllowedChars[JSON_SEEK_ELEMENT] = "tfn0987654321""{[]"



// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] JSONEscape (<sCadena> is string [, <bUsarComillasSimples> is boolean [, <bIncluirComillas> is boolean]])
//
// Parameters:
// sCadena (string): Cadena de texto en formato nativo WinDev
// bUsarComillasSimples (boolean - default value=0): Si el texto sera incluido entre comillas simples (para hacer escape a comillas simples, o comillas dobles)
// bIncluirComillas (boolean - default value=0): Si el texto final se le agregaran comillas (simples o dobles dependiendo del 2do parametro)
// Return Value:
// string: // None
//
// For instance:
// Indicate an example.
//
Procedure JSONEscape(LOCAL sCadena is string, LOCAL bUsarComillasSimples is boolean = False, LOCAL bIncluirComillas is boolean = False)

sNewString is string = sCadena
sNewString = Replace(sNewString, "\", "\\")
IF bUsarComillasSimples THEN
sNewString = Replace(sNewString, "'", "\'")
ELSE
sNewString = Replace(sNewString, """", "\""")
END
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")

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

IF NOT bIncluirComillas THEN
RESULT sJSONString
ELSE
IF bUsarComillasSimples THEN
RESULT "'" + sJSONString + "'"
ELSE
RESULT """" + sJSONString + """"
END
END


Procedure JSONParse(sData is string, aaOutput is associative array of Variant)

arrObjectStack is array of strings
arrIndexes is array of int
arrStates is array of int
nState is int = JSON_SEEK_JSON
sExpected is string = ""
sCurrChar is string = ""
sCurrToken is string = ""
sCurrKey is string = ""
bPrevScape is boolean = False
sHexChar is string
nHexVal is int
nToSkip is int = 0
sBasePath is string = ""
nCurrIndex is int
sWritePath is string = ""
vValToWrite is Variant = Null

i is int = 1
WHILE i <= Length(sData)
IF nToSkip > 0 THEN
nToSkip -= 1
i++
CONTINUE
END
sCurrChar = sData[[i]]
sExpected = gaaAllowedChars[nState]
IF sExpected <> "" THEN
IF Position(sExpected, sCurrChar) < 1 THEN
i++
CONTINUE
END
END

IF JSON_PARSE_DEBUG THEN
IF ArrayCount(arrObjectStack) > 0 THEN
Trace(sCurrChar, " " + gaaStateNames[nState], sBasePath, " stack", ArrayCount(arrObjectStack), arrObjectStack[ArrayCount(arrObjectStack)], gaaStateNames[arrStates[ArrayCount(arrStates)]])
ELSE
Trace(sCurrChar, " " + gaaStateNames[nState], sBasePath, " stack", ArrayCount(arrObjectStack))
END
END

SWITCH nState
CASE JSON_SEEK_JSON:
IF sCurrChar = "{" THEN
nState = JSON_SEEK_TUPLE
sBasePath = ""
ELSE IF sCurrChar = "[" THEN
nState = JSON_SEEK_ELEMENT
sBasePath = "["
nCurrIndex = 0
END
CASE JSON_SEEK_TUPLE:
IF sCurrChar = """" THEN
sCurrToken = """"
nState = JSON_FINISH_KEY
bPrevScape = False
ELSE IF sCurrChar = "," THEN
sCurrToken = ""
bPrevScape = False
ELSE IF sCurrChar = "}" THEN
IF ArrayCount(arrObjectStack) = 0 THEN
RESULT True // Fin
END

sBasePath = arrObjectStack[ArrayCount(arrObjectStack)]
ArrayDelete(arrObjectStack, ArrayCount(arrObjectStack))
nState = arrStates[ArrayCount(arrStates)]
ArrayDelete(arrStates, ArrayCount(arrStates))
sCurrKey = ""

IF nState = JSON_SEEK_ELEMENT_SEP THEN
nCurrIndex = arrIndexes[ArrayCount(arrIndexes)]
ArrayDelete(arrIndexes, ArrayCount(arrIndexes))
END
END
CASE JSON_SEEK_TUPLE_SEP:
nState = JSON_SEEK_VALUE
CASE JSON_SEEK_VALUE, JSON_SEEK_ELEMENT:
IF nState = JSON_SEEK_ELEMENT THEN
IF ArrayCount(arrObjectStack) = 0 THEN
sBasePath = ""
ELSE
sBasePath = arrObjectStack[ArrayCount(arrObjectStack)]
END
IF sCurrChar <> "]" THEN
nCurrIndex += 1
END
sWritePath = sBasePath + "[" + nCurrIndex + "]"
END
IF sCurrChar = "{" THEN
IF nState = JSON_SEEK_ELEMENT THEN
ArrayAdd(arrIndexes,nCurrIndex)
ArrayAdd(arrObjectStack, sWritePath)
ArrayAdd(arrStates, JSON_SEEK_ELEMENT_SEP)
ELSE
IF JSON_PARSE_DEBUG THEN
Trace(" push", sBasePath, sWritePath)
END
ArrayAdd(arrObjectStack, sBasePath)
ArrayAdd(arrStates, JSON_SEEK_TUPLE)
END

nState = JSON_SEEK_TUPLE
sBasePath = sWritePath
ELSE IF sCurrChar = "[" THEN
IF nState = JSON_SEEK_ELEMENT THEN
ArrayAdd(arrIndexes,nCurrIndex)
ArrayAdd(arrObjectStack, sWritePath)
ArrayAdd(arrStates, JSON_SEEK_ELEMENT_SEP)

ArrayAdd(arrObjectStack, sWritePath)
ELSE
IF JSON_PARSE_DEBUG THEN
Trace(" push", sBasePath, sWritePath)
END
ArrayAdd(arrObjectStack, sBasePath)
ArrayAdd(arrStates, JSON_SEEK_TUPLE)

ArrayAdd(arrObjectStack, sWritePath)
END

nCurrIndex = 0
nState = JSON_SEEK_ELEMENT
sBasePath = sWritePath
ELSE IF sCurrChar = "]" THEN
nState = JSON_SEEK_ELEMENT_SEP

IF JSON_PARSE_DEBUG THEN
IF ArrayCount(arrObjectStack) > 0 THEN
Trace(" ", gaaStateNames[nState], sBasePath, " stack", ArrayCount(arrObjectStack), arrObjectStack[ArrayCount(arrObjectStack)], gaaStateNames[arrStates[ArrayCount(arrStates)]])
ELSE
Trace(" ", gaaStateNames[nState], sBasePath, " stack", ArrayCount(arrObjectStack))
END
END

CONTINUE
ELSE IF sCurrChar = "t" THEN
nState = nState = JSON_SEEK_VALUE ? JSON_FINISH_TRUE ELSE JSON_FINISH_TRUE_ELEM
ELSE IF sCurrChar = "f" THEN
nState = nState = JSON_SEEK_VALUE ? JSON_FINISH_FALSE ELSE JSON_FINISH_FALSE_ELEM
ELSE IF sCurrChar = "n" THEN
nState = nState = JSON_SEEK_VALUE ? JSON_FINISH_NULL ELSE JSON_FINISH_NULL_ELEM
ELSE IF sCurrChar = """" THEN
sCurrToken = """"
nState = nState = JSON_SEEK_VALUE ? JSON_FINISH_STRING ELSE JSON_FINISH_STRING_ELEM
ELSE
sCurrToken = sCurrChar
nState = nState = JSON_SEEK_VALUE ? JSON_FINISH_NUMERIC ELSE JSON_FINISH_NUMERIC_ELEM
END
CASE JSON_SEEK_ELEMENT_SEP:
IF sCurrChar = "," THEN
nState = JSON_SEEK_ELEMENT
ELSE IF sCurrChar = "]" THEN
IF ArrayCount(arrObjectStack) = 0 THEN
sBasePath = ""
ELSE
sBasePath = arrObjectStack[ArrayCount(arrObjectStack)]
END
IF sBasePath = "" THEN
aaOutput["count"] = nCurrIndex
ELSE
aaOutput[sBasePath + ".count"] = nCurrIndex
END
IF ArrayCount(arrObjectStack) = 0 THEN
RESULT True // Es solo un arreglo
END

ArrayDelete(arrObjectStack, ArrayCount(arrObjectStack))

IF ArrayCount(arrObjectStack) = 0 THEN
sBasePath = ""
ELSE
sBasePath = arrObjectStack[ArrayCount(arrObjectStack)]
END
ArrayDelete(arrObjectStack, ArrayCount(arrObjectStack))
nState = arrStates[ArrayCount(arrStates)]
ArrayDelete(arrStates, ArrayCount(arrStates))
sCurrKey = ""

IF nState = JSON_SEEK_ELEMENT_SEP THEN
nCurrIndex = arrIndexes[ArrayCount(arrIndexes)]
ArrayDelete(arrIndexes, ArrayCount(arrIndexes))
END
END
CASE JSON_FINISH_KEY, JSON_FINISH_STRING, JSON_FINISH_STRING_ELEM:
IF bPrevScape THEN
SWITCH sCurrChar
CASE """":
sCurrToken += """"
CASE "/":
sCurrToken += "/"
CASE "\":
sCurrToken += "\"
CASE "b":
sCurrToken += Charact(8)
CASE "f":
sCurrToken += Charact(12)
CASE "n":
sCurrToken += Charact(10)
CASE "r":
sCurrToken += Charact(13)
CASE "u":
sHexChar = sData[[i+1 TO i+5]]
nHexVal = Val(sHexChar, "x")
nToSkip = 4
sCurrToken += UTF8ToString(UnicodeToAnsi(CharactUnicode(nHexVal)))
OTHER CASE
RESULT False // Error
END
bPrevScape = False
ELSE
IF sCurrChar = "\" THEN
bPrevScape = True
ELSE
sCurrToken += sCurrChar

IF sCurrChar = """" THEN
IF nState = JSON_FINISH_KEY THEN
sCurrKey = sCurrToken[[2 TO Length(sCurrToken) - 1]]
nState = JSON_SEEK_TUPLE_SEP

sWritePath = sBasePath
IF sWritePath <> "" THEN
sWritePath += "."
END
sWritePath += sCurrKey
ELSE IF nState = JSON_FINISH_STRING THEN
sCurrToken = sCurrToken[[2 TO Length(sCurrToken) - 1]]
nState = JSON_SEEK_TUPLE

aaOutput[sWritePath] = sCurrToken
ELSE IF nState = JSON_FINISH_STRING_ELEM THEN
sCurrToken = sCurrToken[[2 TO Length(sCurrToken) - 1]]
nState = JSON_SEEK_ELEMENT_SEP

aaOutput[sWritePath] = sCurrToken
END
END
END
END
CASE JSON_FINISH_TRUE, JSON_FINISH_TRUE_ELEM:
IF sData[[i TO i+2]] <> "rue" THEN
RESULT False // Error
END
sCurrToken = "1"
vValToWrite = True
nToSkip = 3

IF nState = JSON_FINISH_TRUE THEN
aaOutput[sWritePath] = vValToWrite

nState = JSON_SEEK_TUPLE
ELSE
aaOutput[sWritePath] = vValToWrite

nState = JSON_SEEK_ELEMENT_SEP
END
CASE JSON_FINISH_FALSE, JSON_FINISH_FALSE_ELEM:
IF sData[[i TO i+3]] <> "alse" THEN
RESULT False // Error
END
sCurrToken = "0"
vValToWrite = False
nToSkip = 4

IF nState = JSON_FINISH_FALSE THEN
aaOutput[sWritePath] = vValToWrite

nState = JSON_SEEK_TUPLE
ELSE
aaOutput[sWritePath] = vValToWrite

nState = JSON_SEEK_ELEMENT_SEP
END
CASE JSON_FINISH_NULL, JSON_FINISH_NULL_ELEM:
IF sData[[i TO i+2]] <> "ull" THEN
RESULT False // Error
END
sCurrToken = ""
vValToWrite = Null
nToSkip = 3

IF nState = JSON_FINISH_NULL THEN
aaOutput[sWritePath] = vValToWrite

nState = JSON_SEEK_TUPLE
ELSE
aaOutput[sWritePath] = vValToWrite

nState = JSON_SEEK_ELEMENT_SEP
END
CASE JSON_FINISH_NUMERIC, JSON_FINISH_NUMERIC_ELEM:
IF Position("+-1234567890.eE", sCurrChar) >= 1 THEN
sCurrToken += sCurrChar
ELSE
vValToWrite = Val(sCurrToken)
IF nState = JSON_FINISH_NUMERIC THEN
aaOutput[sWritePath] = vValToWrite

nState = JSON_SEEK_TUPLE
ELSE
aaOutput[sWritePath] = vValToWrite

nState = JSON_SEEK_ELEMENT_SEP
END

IF JSON_PARSE_DEBUG THEN
IF ArrayCount(arrObjectStack) > 0 THEN
Trace(" ", gaaStateNames[nState], sBasePath, " stack", ArrayCount(arrObjectStack), arrObjectStack[ArrayCount(arrObjectStack)], gaaStateNames[arrStates[ArrayCount(arrStates)]])
ELSE
Trace(" ", gaaStateNames[nState], sBasePath, " stack", ArrayCount(arrObjectStack))
END
END

CONTINUE
END
OTHER CASE
RESULT False // Error
END

IF JSON_PARSE_DEBUG THEN
IF ArrayCount(arrObjectStack) > 0 THEN
Trace(" ", gaaStateNames[nState], sBasePath, " stack", ArrayCount(arrObjectStack), arrObjectStack[ArrayCount(arrObjectStack)], gaaStateNames[arrStates[ArrayCount(arrStates)]])
ELSE
Trace(" ", gaaStateNames[nState], sBasePath, " stack", ArrayCount(arrObjectStack))
END
END

i++
END

RESULT True



COMO USAR A PROCEDURE JSON_UTIL:

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] AMPLA_WS (<UC> is string, <DV> is string)
//
// Parameters:
// UC (ANSI string): <specify the role of UC>
// DV (ANSI string): <specify the role of DV>
// Return Value:
// Unspecified Type: // None
//
// For instance:
// Indicate an example.
//
// Resultado do json retornado pelo webservice da AMPLA
//{ "Mensagem":"",
// "Retorno"(movember)
// "uc_consultada":"534390",
// "dv_consultado":"9",
// "Nome":"MARCIO ALEXANDRE DE OLIVEIRA SILVA",
// "DiaVencimento":"10",
// "Est_Fat":"NÃO",
// "Estado":"ATIVO",
// "EstForn":"COM FORNECIMENTO",
// "OBS":"",
// "CPF":"00000000000022237287",
// "CPFDV":"74",
// "TipoDocumento1":"CPF",
// "Doc1":"00000000000022237287",
// "DocDV1":"74",
// "TipoDocumento2":"RG",
// "Doc2":"00000000000009385754",
// "DocDV2":"8",
// "Email":"MARCIOALEX.OLIVER@HOTMAIL.COM",
// "ddd":"",
// "tel":"27207183",
// "Endereco":"R EUCLIDES MARTINS 39",
// "Municipio":"SAO GONCALO",
// "Localidade":"NEVES",
// "UF":"RIO DE JANEIRO"
// }
//}

Procedure AMPLA_WS( UC is string, DV is string)

// Prepara autenticação no webservice
Autenticacao is ValidationSoapHeader
Autenticacao.empresa = "xxxxx"
Autenticacao.usuario = "yyyyyy"
Autenticacao.senha = "zzzzzzz"
SOAPAddHeader(consulta,Autenticacao)

// Prepara Cliente a consultar
ClienteAMPLA is Consultar
ClienteAMPLA.uc_ = UC
ClienteAMPLA.dv_ = DV

// Faz a consulta
Result_JSon is string = Consultar(ClienteAMPLA)
IF ErrorOccurred() THEN
Error("Falha ao acessar o site da AMPLA",ErrorInfo())
RESULT False
END

// Transforna json em array - array declaraddo no Projeto
ArrayDeleteAll(aaRetorno_WS_AMPLA)
JSONParse(Result_JSon,aaRetorno_WS_AMPLA)

// Valores Retornados no array
// aaRetorno_WS_AMPLA["Mensagem"]
// aaRetorno_WS_AMPLA["Retorno.uc_consultada"]
// aaRetorno_WS_AMPLA["Retorno.dv_consultado"]
// aaRetorno_WS_AMPLA["Retorno.Nome"]
// aaRetorno_WS_AMPLA["Retorno.DiaVencimento"]
// aaRetorno_WS_AMPLA["Retorno.Est_Fat"]
// aaRetorno_WS_AMPLA["Retorno.Estado"]
// aaRetorno_WS_AMPLA["Retorno.EstForn"]
// aaRetorno_WS_AMPLA["Retorno.OBS"]
// aaRetorno_WS_AMPLA["Retorno.CPF"]
// aaRetorno_WS_AMPLA["Retorno.CPFDV"]
// aaRetorno_WS_AMPLA["Retorno.TipoDocumento1"]
// aaRetorno_WS_AMPLA["Retorno.Doc1"]
// aaRetorno_WS_AMPLA["Retorno.DocDV1"]
// aaRetorno_WS_AMPLA["Retorno.TipoDocumento2"]
// aaRetorno_WS_AMPLA["Retorno.Doc2"]
// aaRetorno_WS_AMPLA["Retorno.DocDV2"]
// aaRetorno_WS_AMPLA["Retorno.Email"]
// aaRetorno_WS_AMPLA["Retorno.ddd"]
// aaRetorno_WS_AMPLA["Retorno.tel"]
// aaRetorno_WS_AMPLA["Retorno.Endereco"]
// aaRetorno_WS_AMPLA["Retorno.Municipio"]
// aaRetorno_WS_AMPLA["Retorno.Localidade"]
// aaRetorno_WS_AMPLA["Retorno.UF"]

RESULT aaRetorno_WS_AMPLA


Código exemplo enviado pelo Desenvolvedor WL: Marcelo Braga dos Santos, skype: marcelobragasantos

Meu muito obrigado!

:merci:

--
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/
Mensagem modificada, abril, 21 2016 - 1:41 PM
Membro registado
3.651 mensagems
Popularité : +175 (223 votes)
Publicado em abril, 21 2016 - 1:45 PM
Outro método:

Procedure JsonToAnsi(TextoJson)

res is string

iniciouString is boolean

i is int=1

LOOP

IF i > Length(TextoJson) THEN BREAK

IF TextoJson[[i]]="""" THEN

iniciouString=1-iniciouString ; res+=""""; i++

ELSE

IF iniciouString THEN // dentro do "string"

IF TextoJson[[i]]="\" AND i<Length(TextoJson) THEN // dentro da sequencia Escape "\"

SWITCH TextoJson[[i+1]]

CASE """" : res+="""" ; i+=2 // quotation mark

CASE "\" : res+="\" ; i+=2 // reverse solidus

CASE "/" : res+="/" ; i+=2 // solidus

CASE "b" : res+="<" ; i+=2 // backspace

CASE "f" : res+=CR+CR ; i+=2 // formfeed

CASE "n" : res+=CR ; i+=2 // new line

CASE "r" : res+=CR ; i+=2 // carriage return

CASE "t" : res+=TAB ; i+=2 // horizontal Tab

CASE "u" : // hexadecimal digits \u1234

IF i+5 <= Length(TextoJson) THEN

res+=Charact(HexaToInt(TextoJson[[i+2 TO i+5]]))

i+=6

END

OTHER CASE

res+=TextoJson[[i]]; i++

END

ELSE // fora da sequencia Escape "\"

res+=TextoJson[[i]]; i++

END

ELSE // fora do "string"

res+=TextoJson[[i]]; i++

END

END

END

RESULT res


NOTE O USO:

JSONTOVARIANT

Trace(VariantToJSON(Person))


--
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/
Membro registado
3.651 mensagems
Popularité : +175 (223 votes)
Publicado em abril, 21 2016 - 2:45 PM
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

// Summary: <specify the procedure action>
// Syntax:
//Constructor ( [<sJSONCode> is string [, <sName> is string]])
//
// Parameters:
// sJSONCode (string - default value="{}"): <specify the role of sJSONCode>
// sName (string): <specify the role of sName>
// Return Value:
// None
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
// Destructor ()
//
// Parameters:
// None
// Return Value:
// None
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
// [ <Result> = ] Read (<sPath> is string [, ...])
//
// Parameters:
// sPath (string): <specify the role of sPath>
// Return Value:
// Unspecified Type: <specify the possible values as well as their interpretation>
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] NewProperty (<sPath> is string [, <Type> is int [, <vValue> [, ...]]])
//
// Parameters:
// sPath (string): <specify the role of Path>
// Type (int - default value=3): <specify the role of Type>
// vValue (default value=0): <specify the role of Value>
// Return Value:
// JSON dynamic: // None
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] SeekBase (<sPath> is string, <LastProperty> [, ...])
//
// Parameters:
// sPath (string): <specify the role of Path>
// LastProperty: <specify the role of LastProperty>
// Return Value:
// Unspecified Type: // None
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] ToJsonString (<WindevString> is string)
//
// Parameters:
// WindevString (string): <specify the role of WindevString>
// Return Value:
// string: // None
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] Serialize ()
//
// Parameters:
// None
// Return Value:
// string: // None
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] JsonDataSource (<DataSource> [, <Tag> is int])
//
// Parameters:
// DataSource: <specify the role of DataSource>
// Tag (int - default value=-1): <specify the role of Tag>
// Return Value:
// JSON dynamic: // None
//
// For instance:
// Indicate an example.
//
// RootName (string): <specify the role of RootName>
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

// Summary: <specify the procedure action>
// Syntax:
//RenderDataSource (<DataSource> [, <Tag> is int])
//
// Parameters:
// DataSource: <specify the role of DataSource>
// Tag (int - default value=-1): <specify the role of Tag>
// Return Value:
// None
//
// For instance:
// Indicate an example.
//
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)

//stringdisplay(resp.Serialize(),"application/json")



METHOD RenderOk

// Summary: <specify the procedure action>
// Syntax:
//RenderOk ()
//
// Parameters:
// None
// Return Value:
// None
//
// For instance:
// Indicate an example.
//
Procedure GLOBAL RenderOk()

//stringdisplay("{""status"":""ok""}", "application/json")



METHOD RenderException

// Summary: <specify the procedure action>
// Syntax:
//RenderException ()
//
// Parameters:
// None
// Return Value:
// None
//
// For instance:
// Indicate an example.
//
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))

//stringdisplay(err.Serialize(), "application/json")



METHOD JsonRecord

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] JsonRecord (<DataSource> [, <Tag> is int])
//
// Parameters:
// DataSource: <specify the role of DataSource>
// Tag (int - default value=-1): <specify the role of Tag>
// Return Value:
// JSON dynamic: // None
//
// For instance:
// Indicate an example.
//
// RootName (string): <specify the role of RootName>
// DataSource: <specify the role of DataSource>
// Tag (int - default value=-1): <specify the role of Tag>
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

// Summary: <specify the procedure action>
// Syntax:
//RenderRecord (<DataSource> [, <Tag> is int])
//
// Parameters:
// DataSource: <specify the role of DataSource>
// Tag (int - default value=-1): <specify the role of Tag>
// Return Value:
// None
//
// For instance:
// Indicate an example.
//
// DataSource: <specify the role of DataSource>
// Tag (int - default value=-1): <specify the role of Tag>
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)

//stringdisplay(resp.Serialize(),"application/json")



METHOD ItemType

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] ItemType (<ItemName> is string)
//
// Parameters:
// ItemName (string): <specify the role of ItemName>
// Return Value:
// int: // None
//
// For instance:
// Indicate an example.
//
Procedure GLOBAL ItemType(LOCAL ItemName is string)

JsonType is int = JSON::JSON_TYPE_NULL

nType is int = {ItemName, indItem}..Type
SWITCH nType
CASE 14: //Date
JsonType = JSON::JSON_TYPE_STRING
CASE 11: //Time
JsonType = JSON::JSON_TYPE_STRING
CASE 2: //Text
JsonType = JSON::JSON_TYPE_STRING
CASE 17: //Currency
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 28: //Number
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 5: //Number
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 27: //Check
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 15: //Text Memo
JsonType = JSON::JSON_TYPE_STRING
CASE 3: // Boolean
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

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] JsonObject (<pclObj> is dynamic object [, <Tag> is int])
//
// Parameters:
// pclObj (dynamic object): <specify the role of pclObj>
// Tag (int - default value=-1): <specify the role of Tag>
// Return Value:
// JSON dynamic: // None
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] VarType (<nType> is int)
//
// Parameters:
// nType (int): <specify the role of nType>
// Return Value:
// int: // None
//
// For instance:
// Indicate an example.
//
Procedure GLOBAL VarType(LOCAL nType is int)

JsonType is int = JSON::JSON_TYPE_STRING

SWITCH nType
CASE 14: //Date
JsonType = JSON::JSON_TYPE_STRING
CASE 11: //Time
JsonType = JSON::JSON_TYPE_STRING
CASE 2: //Text
JsonType = JSON::JSON_TYPE_STRING
CASE 17: //Currency
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 28: //Number
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 5: //Number
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 27: //Check
JsonType = JSON::JSON_TYPE_NUMERIC
CASE 15: //Text Memo
JsonType = JSON::JSON_TYPE_STRING
CASE 3: // Boolean
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

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] WlType (<nType> is int)
//
// Parameters:
// nType (int): <specify the role of nType>
// Return Value:
// int: // None
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] JsonArray (<ToArray> is array)
//
// Parameters:
// ToArray (array): <specify the role of ToArray>
// Return Value:
// JSON dynamic: // None
//
// For instance:
// Indicate an example.
//
// Tag (int - default value=-1): <specify the role of Tag>
// nTag (int - default value=-1): <specify the role of nTag>
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

// Summary: <specify the procedure action>
// Syntax:
//JsonAny (<pclObjJson> is JSON dynamic, <sName> is string, <value>)
//
// Parameters:
// pclObjJson (JSON dynamic): <specify the role of pclObjJson>
// sName (string): <specify the role of value>
// value: <specify the role of value>
// Return Value:
// None
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] JsonStructure (<pclObj> [, <Tag> is int])
//
// Parameters:
// pclObj: <specify the role of pclObj>
// Tag (int - default value=-1): <specify the role of Tag>
// Return Value:
// JSON dynamic: // None
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
//RenderArray (<ToArray> is array)
//
// Parameters:
// ToArray (array): <specify the role of DataSource>
// Return Value:
// None
//
// For instance:
// Indicate an example.
//
// DataSource: <specify the role of DataSource>
// Tag (int - default value=-1): <specify the role of Tag>
// Tag (int - default value=-1): <specify the role of Tag>
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)

//stringdisplay(resp.Serialize(),"application/json")



METHOD RenderObject

// Summary: <specify the procedure action>
// Syntax:
//RenderObject (<pclObj> is dynamic object)
//
// Parameters:
// pclObj (dynamic object): <specify the role of DataSource>
// Return Value:
// None
//
// For instance:
// Indicate an example.
//
// DataSource: <specify the role of DataSource>
// Tag (int - default value=-1): <specify the role of Tag>
// DataSource: <specify the role of DataSource>
// Tag (int - default value=-1): <specify the role of Tag>
// Tag (int - default value=-1): <specify the role of Tag>
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)

//stringdisplay(resp.Serialize(),"application/json")



METHOD JsonAssociative

// Summary: <specify the procedure action>
// Syntax:
//[ <Result> = ] JsonAssociative (<ToAssoc>)
//
// Parameters:
// ToAssoc: <specify the role of ToAssoc>
// Return Value:
// JSON dynamic: // None
//
// For instance:
// Indicate an example.
//
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

// Summary: <specify the procedure action>
// Syntax:
//RenderAssociative (<pclObj>)
//
// Parameters:
// pclObj: <specify the role of pclObj>
// Return Value:
// None
//
// For instance:
// Indicate an example.
//
// DataSource: <specify the role of DataSource>
// Tag (int - default value=-1): <specify the role of Tag>
// DataSource: <specify the role of DataSource>
// Tag (int - default value=-1): <specify the role of Tag>
// Tag (int - default value=-1): <specify the role of Tag>
// pclObj (dynamic object): <specify the role of DataSource>
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)

//stringdisplay(resp.Serialize(),"application/json")


CASO TENHA SUGESTOES DE MELHORIAS
ENTRE EM CONTATO

:merci:

--
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/
Membro registado
123 mensagems
Popularité : +46 (46 votes)
Publicado em abril, 21 2016 - 6:01 PM
Adriano muito interesante o exemplo.
Teria o Projeto com os fontes do exemplo?

--
Atte. Willian Fernando
Membro registado
3.651 mensagems
Popularité : +175 (223 votes)
Publicado em abril, 22 2016 - 1:35 PM
:merci:

--
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/
Membro registado
3.651 mensagems
Popularité : +175 (223 votes)
Publicado em abril, 25 2016 - 9:37 AM
Outra técnica

http://help.windev.com/en-US/…

//VariantToJson

Pessoa é Variant
pessoa . LastName = "MOORE"
pessoa . FirstName = "Vince"

Traço ( VariantToJSON ( Person ))

//Resultado:
// Displays: { "Sobrenome": "MOORE", "Nome": "Vince"}


--
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/
Membro registado
3.651 mensagems
Popularité : +175 (223 votes)
Publicado em junho, 08 2016 - 1:37 AM
Exemplo de Serialize

http://help.windev.com/en-US/…

// Structure to transform into JSON
ST_Product is structure
// <Serialize> allows you to have a different name in JSON
sName is string <Serialize ="ProductName">
nID is int
nQty is int
mValue is currency <Serialize ="Amount">
END
ST_Person is structure
sLastName is string <Serialize ="LastName">
sFirstName is string <Serialize ="FirstName">
dDOB is Date
arrProducts is array of ST_Product
END
arrPersons is array of ST_Person

// Fill the data
nPersonSubscript is int
nProductSubscript is int
nPersonSubscript = ArrayAdd(arrPersons)
arrPersons[nPersonSubscript].sLastName = "Doe"
arrPersons[nPersonSubscript].sFirstName = "John"
arrPersons[nPersonSubscript].dDOB = "19880516"

nProductSubscript = ArrayAdd(arrPersons[mPersonSubscript].arrProducts)
arrPersons[nPersonSubscript].arrProducts[nProductSubscript].mValue = 89.9
arrPersons[nPersonSubscript].arrProducts[nProductSubscript].nID = 12345724
arrPersons[nPersonSubscript].arrProducts[nProductSubscript].nQty = 5
arrPersons[nPersonSubscript].arrProducts[nProductSubscript].sName = "Red jacket"

// Retrieve the JSON code
bufJson is Buffer
Serialize(arrPersons.bufJson, psdJSON
//[ {
// "LastName":"Doe",
// "FirstName":"John",
// "dDOB":"1988-05-16",
// "arrProducts":[ {
// "ProductName":"Red jacket",
// "nID":12345724,
// "nQty":5,
// "Amount":89.9
// } ]
// } ]

// Send the JSON to a site by POST
HTTPCreateForm("JSONForm")
HTTPAddParameter("JSONForm", "JSONPERSON", bufJson)
HTTPSendForm("JSONForm", ...
"http://MySite/MySite_WEB/US/PAGE_Persons.awp", httpPost)




Exemplo de Deserialize

http://help.windev.com/en-US/…

// This example explains how to use the Serialize/Deserialize functions
// with an Array variable.
// These functions can use all types of WLanguage variables.


MyArray is array of strings
bufResult is Buffer

// Adds elements into the array
Add(MyArray, "WINDEV")
Add(MyArray, "WEBDEV")
Add(MyArray, "WINDEV MOBILE")

// Serialize the array in the buffer in JSON
// => Save the array and its entire content in a JSON string
Serialize(MyArray, bufResult, psdJSON)

// Deserialize the JSON buffer
// => Rebuild the WLanguage array from the JSON string
MyRebuiltArray is array of strings
Deserialize(MyRebuiltArray, bufResult, psdJSON)





Exemplo de Structure

http://help.windev.com/en-US/…

// Declare a structure
ProductRef is structure
SCode is int
PdtCode is fixed string on 10
END

// Declare a structure variable
ProductRef is structure
SCode is int
PdtCode is fixed string on 10
END

Armchair is ProductRef

// Handle a member of a structure variable
ProductRef is structure
SCode is int
PdtCode is fixed string on 10
END

Armchair is ProductRef
Armchair:SCode = 7
Armchair:PdtCode = "Furniture"


--
Adriano José Boller
______________________________________________
Consultor e Representante Oficial da
PcSoft no Brasil
+55 (41) 9949 1800
adrianoboller@gmail.com
skype: adrianoboller
http://wxinformatica.com.br/
Membro registado
3.651 mensagems
Popularité : +175 (223 votes)
Publicado em junho, 08 2016 - 1:46 AM
Prezados,

Links e fontes para download

http://repository.windev.com/resource.awp…;

http://repository.windev.com/resource.awp…

Bons estudos

:merci:

--
Adriano José Boller
______________________________________________
Consultor e Representante Oficial da
PcSoft no Brasil
+55 (41) 9949 1800
adrianoboller@gmail.com
skype: adrianoboller
http://wxinformatica.com.br/
Membro registado
123 mensagems
Popularité : +46 (46 votes)
Publicado em junho, 08 2016 - 3:57 PM
No Mobile ate a Vr 20 (não sei como esta na 21) so pode consumir um JSON montando Structure, onde cada elemento da Structure deve ter o mesmo nome de cada elemento do JSON e na mesma orden, veja os exemplos







logo na hora de consumir seria algo como isto
(aqui uso Webservices, mas poderia ser via HTTP direto se for o caso)






--
Atte. Willian Fernando
Membro registado
3.651 mensagems
Popularité : +175 (223 votes)
Publicado em junho, 08 2016 - 4:20 PM
:merci:

--
Adriano José Boller
______________________________________________
Consultor e Representante Oficial da
PcSoft no Brasil
+55 (41) 9949 1800
adrianoboller@gmail.com
skype: adrianoboller
http://wxinformatica.com.br/