*
* vfpjson
*
* ----------------------------------
* -----------------------------------
*
* JSON Library in VFP
* Libreria para el manejo de JSON en VFP
*
* [Link]
* Thanks Google for the code in Json Dart
* Gracias a Google por el codigo de Json de Dart
*
* json_encode(xExpr)
* returns a string, that is the json of any expression passed
*
* json_decode(cJson)
* returns an object, from the string passed
*
* json_getErrorMsg()
* returns empty if no error found in last decode.
*
*
*
* Examples:
*
* set procedure json additive
* oPerson = json_decode(' { "name":"Ignacio" , "lastname":"Gutierrez", "age":33 }
')
* if not empty(json_getErrorMsg())
* ? 'Error in decode:'+json_getErrorMsg())
* return
* endif
* ? [Link]('name') , [Link]('lastname')
*
*
* oJson = newobject('json','[Link]')
* oCustomer = [Link]( ' { "name":"Ignacio" , "lastname":"Gutierrez", "age":33
} ')
* ? [Link](oCustomer)
* ? [Link]('name')
* ? [Link]('lastname')
*
* obj = [Link]('{"jsonrpc":"1.0", "id":1, "method":"sumArray", "params":
[3.1415,2.14,10],"version":1.0}')
* ? [Link]('jsonrpc'), obj._jsonrpc
* ? [Link]('id'), obj._id
* ? [Link]('method'), obj._method
* ? obj._Params.array[1], obj._Params.get(1)
*
*
*
*
lRunTest = .t.
if lRunTest
testJsonClass()
endif
return
function json_encode(xExpr)
if vartype(_json)<>'O'
public _json
_json = newobject('json')
endif
return _json.encode(@xExpr)
function json_decode(cJson)
local retval
if vartype(_json)<>'O'
public _json
_json = newobject('json')
endif
retval = _json.decode(cJson)
if not empty(_json.cError)
return null
endif
return retval
function json_getErrorMsg()
return _json.cError
*
* recordToJson()
*
* Returns the json representation for current record
* Try it:
* use c:\mydir\mytable
* cInfo = recordToJson()
* ? cInfo
*
function recordToJson
local nRecno,i,oObj, cRetVal
if alias()==''
return ''
endif
oObj = newObject('myObj')
for i=1 to fcount()
[Link](Field(i),eval(Field(i)))
next
cRetVal = json_encode(oObj)
if not empty(json_getErrorMsg())
cRetVal = 'ERROR:'+json_getErrorMsg()
endif
return cRetVal
*
* tableToJson()
*
* Returns the json representation for current table
* Warning need to be changed for large table, because use dimension
aInfo[reccount()]
* For large table should change to create the string record by record.
*
* Try it:
* use c:\mydir\mytable
* cInfo = tableToJson()
* ? cInfo
* _cliptext = strtran(cInfo, ',{"', ','+chr(13)+'{"')
* Go to Any Editor and Paste the information
*
function tableToJson
local nRecno,i,oObj, cRetVal,nRec
if alias()==''
return ''
endif
nRecno = recno()
nRec = 1
dimension aInfo[1]
scan
oObj = newObject('myObj')
for i=1 to fcount()
[Link](Field(i),eval(Field(i)))
next
dimension aInfo[nRec]
aInfo[nRec] = oObj
nRec = nRec+1
endscan
goto nRecno
cRetVal = json_encode(@aInfo)
if not empty(json_getErrorMsg())
cRetVal = 'ERROR:'+json_getErrorMsg()
endif
return cRetVal
*
* json class
*
*
define class json as custom
nPos=0
nLen=0
cJson=''
cError=''
*
* Genera el codigo cJson para parametro que se manda
*
function encode(xExpr)
local cTipo
* Cuando se manda una arreglo,
if type('ALen(xExpr)')=='N'
cTipo = 'A'
Else
cTipo = VarType(xExpr)
Endif
Do Case
Case cTipo=='D'
return '"'+dtos(xExpr)+'"'
Case cTipo=='N'
return Transform(xExpr)
Case cTipo=='L'
return iif(xExpr,'true','false')
Case cTipo=='X'
return 'null'
Case cTipo=='C'
xExpr = allt(xExpr)
xExpr = StrTran(xExpr, '\', '\\' )
xExpr = StrTran(xExpr, '/', '\/' )
xExpr = StrTran(xExpr, Chr(9), '\t' )
xExpr = StrTran(xExpr, Chr(10), '\n' )
xExpr = StrTran(xExpr, Chr(13), '\r' )
xExpr = StrTran(xExpr, '"', '\"' )
return '"'+xExpr+'"'
case cTipo=='O'
local cProp, cJsonValue, cRetVal, aProp[1]
=AMembers(aProp,xExpr)
cRetVal = ''
for each cProp in aProp
*?? cProp,','
*? cRetVal
if type('xExpr.'+cProp)=='U' or cProp=='CLASS'
* algunas propiedades pueden no estar definidas
* como: activecontrol, parent, etc
loop
endif
if type( 'ALen(xExpr.'+cProp+')' ) == 'N'
*
* es un arreglo, recorrerlo usando los [ ] y macro
*
Local i,nTotElem
cJsonValue = ''
nTotElem = Eval('ALen(xExpr.'+cProp+')')
For i=1 to nTotElem
cmd = 'cJsonValue=cJsonValue+","+
[Link]( xExpr.'+cProp+'[i])'
&cmd.
Next
cJsonValue = '[' + substr(cJsonValue,2) + ']'
else
*
* es otro tipo de dato normal C, N, L
*
cJsonValue =
[Link]( evaluate( 'xExpr.'+cProp ) )
endif
if left(cProp,1)=='_'
cProp = substr(cProp,2)
endif
cRetVal = cRetVal + ',' + '"' + lower(cProp) + '":' +
cJsonValue
next
return '{' + substr(cRetVal,2) + '}'
case cTipo=='A'
local valor, cRetVal
cRetVal = ''
for each valor in xExpr
cRetVal = cRetVal + ',' + [Link]( valor )
next
return '[' + substr(cRetVal,2) + ']'
endcase
return ''
*
* regresa un elemento representado por la cadena json que se manda
*
function decode(cJson)
local retValue
cJson = StrTran(cJson,chr(9),'')
cJson = StrTran(cJson,chr(10),'')
cJson = StrTran(cJson,chr(13),'')
cJson = [Link](cJson)
[Link] = 1
[Link] = cJson
[Link] = len(cJson)
[Link] = ''
retValue = [Link]()
if not empty([Link])
return null
endif
if [Link]()<>null
[Link]('Junk at the end of JSON input')
return null
endif
return retValue
function parseValue()
local token
token = [Link]()
if token==null
[Link]('Nothing to parse')
return null
endif
do case
case token=='"'
return [Link]()
case isdigit(token) or token=='-'
return [Link]()
case token=='n'
return [Link]('null',null)
case token=='f'
return [Link]('false',.f.)
case token=='t'
return [Link]('true',.t.)
case token=='{'
return [Link]()
case token=='['
return [Link]()
otherwise
[Link]('Unexpected token')
endcase
return
function expectedKeyword(cWord,eValue)
for i=1 to len(cWord)
cChar = [Link]()
if cChar <> substr(cWord,i,1)
[Link]("Expected keyword '" + cWord + "'")
return ''
endif
[Link] = [Link] + 1
next
return eValue
function parseObject()
local retval, cPropName, xValue
retval = createObject('myObj')
[Link] = [Link] + 1 && Eat {
if [Link]()<>'}'
do while .t.
cPropName = [Link]()
if not empty([Link])
return null
endif
if [Link]()<>':'
[Link]("Expected ':' when parsing object")
return null
endif
[Link] = [Link] + 1
xValue = [Link]()
if not empty([Link])
return null
endif
** Debug ? cPropName, type('xValue')
[Link](cPropName, xValue)
if [Link]()<>','
exit
endif
[Link] = [Link] + 1
enddo
endif
if [Link]()<>'}'
[Link]("Expected '}' at the end of object")
return null
endif
[Link] = [Link] + 1
return retval
function parseArray()
local retVal, xValue
retval = createObject('MyArray')
[Link] = [Link] + 1 && Eat [
if [Link]() <> ']'
do while .t.
xValue = [Link]()
if not empty([Link])
return null
endif
[Link]( xValue )
if [Link]()<>','
exit
endif
[Link] = [Link] + 1
enddo
if [Link]() <> ']'
[Link]('Expected ] at the end of array')
return null
endif
endif
[Link] = [Link] + 1
return retval
function parseString()
local cRetVal, c
if [Link]()<>'"'
[Link]('Expected "')
return ''
endif
[Link] = [Link] + 1 && Eat "
cRetVal = ''
do while .t.
c = [Link]()
if c==''
return ''
endif
if c == '"'
[Link] = [Link] + 1
exit
endif
if c == '\'
[Link] = [Link] + 1
if ([Link]>[Link])
[Link]('\\ at the end of input')
return ''
endif
c = [Link]()
if c==''
return ''
endif
do case
case c=='"'
c='"'
case c=='\'
c='\'
case c=='/'
c='/'
case c=='b'
c=chr(8)
case c=='t'
c=chr(9)
case c=='n'
c=chr(10)
case c=='f'
c=chr(12)
case c=='r'
c=chr(13)
otherwise
******* FALTAN LOS UNICODE
[Link]('Invalid escape sequence in string
literal')
return ''
endcase
endif
cRetVal = cRetVal + c
[Link] = [Link] + 1
enddo
return cRetVal
**** Pendiente numeros con E
function parseNumber()
local nStartPos,c, isInt, cNumero
if not ( isdigit([Link]()) or [Link]()=='-')
[Link]('Expected number literal')
return 0
endif
nStartPos = [Link]
c = [Link]()
if c == '-'
c = [Link]()
endif
if c == '0'
c = [Link]()
else
if isdigit(c)
c = [Link]()
do while isdigit(c)
c = [Link]()
enddo
else
[Link]('Expected digit when parsing number')
return 0
endif
endif
isInt = .t.
if c=='.'
c = [Link]()
if isdigit(c)
c = [Link]()
isInt = .f.
do while isDigit(c)
c = [Link]()
enddo
else
[Link]('Expected digit following dot comma')
return 0
endif
endif
cNumero = substr([Link], nStartPos, [Link] - nStartPos)
return val(cNumero)
function getToken()
local char1
do while .t.
if [Link] > [Link]
return null
endif
char1 = substr([Link], [Link], 1)
if char1==' '
[Link] = [Link] + 1
loop
endif
return char1
enddo
return
function getChar()
if [Link] > [Link]
[Link]('Unexpected end of JSON stream')
return ''
endif
return substr([Link], [Link], 1)
function nextChar()
[Link] = [Link] + 1
if [Link] > [Link]
return ''
endif
return substr([Link], [Link], 1)
function setError(cMsg)
[Link]= 'ERROR parsing JSON at Position:'+allt(str([Link],6,0))
+' '+cMsg
return
function getError()
return [Link]
function fixUnicode(cStr)
cStr = StrTran(cStr,'\u00e1','�')
cStr = StrTran(cStr,'\u00e9','�')
cStr = StrTran(cStr,'\u00ed','�')
cStr = StrTran(cStr,'\u00f3','�')
cStr = StrTran(cStr,'\u00fa','�')
cStr = StrTran(cStr,'\u00c1','�')
cStr = StrTran(cStr,'\u00c9','�')
cStr = StrTran(cStr,'\u00cd','�')
cStr = StrTran(cStr,'\u00d3','�')
cStr = StrTran(cStr,'\u00da','�')
cStr = StrTran(cStr,'\u00f1','�')
cStr = StrTran(cStr,'\u00d1','�')
return cStr
enddefine
*
* class used to return an array
*
define class myArray as custom
nSize = 0
dimension array[1]
function add(xExpr)
[Link] = [Link] + 1
dimension [Link][[Link]]
[Link][[Link]] = xExpr
return
function get(n)
return [Link][n]
function getsize()
return [Link]
enddefine
*
* class used to simulate an object
* all properties are prefixed with 'prop' to permit property names like: error,
init
* that already exists like vfp methods
*
define class myObj as custom
Hidden ;
ClassLibrary,Comment, ;
BaseClass,ControlCount, ;
Controls,Objects,Object,;
Height,HelpContextID,Left,Name, ;
Parent,ParentClass,Picture, ;
Tag,Top,WhatsThisHelpID,Width
function set(cPropName, xValue)
cPropName = '_'+cPropName
do case
case type('ALen(xValue)')=='N'
* es un arreglo
local nLen,cmd,i
[Link](cPropName+'(1)')
nLen = alen(xValue)
cmd = 'Dimension This.'+cPropName+ ' [ '+Str(nLen,10,0)+']'
&cmd.
for i=1 to nLen
cmd = 'This.'+cPropName+ ' [ '+Str(i,10,0)+'] = xValue[i]'
&cmd.
next
case type('this.'+cPropName)=='U'
* la propiedad no existe, definirla
[Link](cPropName,@xValue)
otherwise
* actualizar la propiedad
local cmd
cmd = 'this.'+cPropName+'=xValue'
&cmd
endcase
return
procedure get (cPropName)
cPropName = '_'+cPropName
If type('this.'+cPropName)=='U'
return ''
Else
local cmd
cmd = 'return this.'+cPropName
&cmd
endif
return ''
enddefine
function testJsonClass
clear
set decimal to 10
oJson = newObject('json')
? 'Test Basic Types'
? '----------------'
? [Link]('null')
? [Link]('true')
? [Link]('false')
?
? [Link]('17311')
? [Link]('728.45')
? [Link]('88.45.')
? [Link]('"nacho gtz"')
if not empty([Link])
? [Link]
return
endif
? [Link]('"nacho gtz\nEs \"bueno\"\nMuy Bueno\ba"')
if not empty([Link])
? [Link]
return
endif
? 'Test Array'
? '----------'
arr = [Link]('[3.1416,"Ignacio",false,null]')
? [Link](1), [Link](2), [Link](3), [Link](4)
arr = [Link]('[ ["Hugo","Paco","Luis"] , [ 8,9,11] ] ')
nombres = [Link](1)
edades = [Link](2)
? [Link](1), [Link](1)
? [Link](2), [Link](2)
? [Link](3), [Link](3)
?
? 'Test Object'
? '-----------'
obj = [Link]('{"nombre":"Ignacio", "edad":33.17, "isGood":true}')
? [Link]('nombre'), [Link]('edad'), [Link]('isGood')
? obj._Nombre, obj._Edad, obj._IsGood
obj = [Link]('{"jsonrpc":"1.0", "id":1, "method":"sumArray", "params":
[3.1415,2.14,10],"version":1.0}')
? [Link]('jsonrpc'), obj._jsonrpc
? [Link]('id'), obj._id
? [Link]('method'), obj._method
? obj._Params.array[1], obj._Params.get(1)
?
? 'Test nested object'
? '------------------'
cJson = '{"jsonrpc":"1.0", "id":1, "method":"upload", "params": {"data":
{ "usrkey":"2415af77b", "sendto":"ignacio@[Link]", "name":"Ignacio
is \"Nacho\"","expires":"20120731" }}}'
obj = [Link](cJson)
if not empty([Link])
? [Link]
return
endif
? cJson
? 'method -->',obj._method
? 'usrkey -->',obj._params._data._usrkey
? 'sendto -->',obj._params._data._sendto
? 'name --->',obj._params._data._name
? 'expires ->',obj._params._data._expires
?
? 'Test empty object'
? '-----------------'
cJson = '{"result":null,"error":{"code":-3200.012,"message":"invalid
usrkey","data":{}},"id":"1"}'
obj = [Link](cJson)
if not empty([Link])
? [Link]
return
endif
? cJson
? 'result -->',obj._result, [Link]('result')
oError = [Link]('error')
? 'ErrCode ->',obj._error._code, [Link]('code')
? 'ErrMsg -->',obj._error._message, [Link]('message')
? 'id ----->',obj._id, [Link]('id')
? type("oError._code")
?
? 'Probar decode-enconde-decode-encode'
? '------------------------------------'
cJson = ' {"server":"", "user":"", "password":"" ,'+;
' "port":0, "auth":false, "ssl":false, "timeout":20,
"error":404}'
? cJson
oSmtp = json_decode(cJson)
cJson = json_encode(oSmtp)
? cJson
oSmtp = json_decode(cJson)
cJson = json_encode(oSmtp)
? cJson
* Probar falla
?
? 'Probar una falla en el json'
? '---------------------------'
cJson = ' {"server":"", "user":"", "password":"" ,'
oSmtp = json_decode(cJson)
if not empty(json_getErrorMsg())
? json_getErrorMsg()
endif
?
? 'Pruebas Finalizadas'
return