PB 生成和解析JSON格式数据

一 创建用户对象sailjson

forward
global type sailjson from nonvisualobject
end type
type json_pair from structure within sailjson
end type
end forward

type json_pair from structure
	string		name
	any		value
end type

global type sailjson from nonvisualobject
end type
global sailjson sailjson

type variables
/*
	Sailjson:from www.pblsoft.com
	Please reserve this information
	
	Version:2.1
	Release date:2016-1-13
	update:add root is array. getrootarray
	
	Version:2.0
	Release date:2016-1-1
*/

private:
	json_pair pairs[]
	string is_json
	char ichars[]
	long idx, imaxlen

	treeview tree
	integer objectpcxidx, arraypcxidx, itempcxidx
	string is_ident
public:
	boolean ignoreCase = false
	integer ilevel
	string pair_index

end variables

forward prototypes
public function string parse (string as_json)
public function integer getarray (string itemname, ref any va[])
public function boolean isarray (any value)
public function any getattribute (string itemname)
private function integer of_readobject (sailjson vjson, integer alevel)
private subroutine of_error (string msg)
private subroutine skipspc ()
private function long findpairindex (string as_name)
private function string of_getformat (sailjson ajson, string ident)
private function string mymid (character vchars[], long vstart, long vlen)
public subroutine buildtree (treeview atree, long handle, integer aobjectpcxidx, integer aarraypcxidx, integer aitempcxidx)
private subroutine of_buildtree (sailjson ajson, long handle)
public subroutine setattribute (string as_name, any aa_value)
public function any addarrayitem (string arrayname)
public function any addobject (string objname)
public function string getformatjson (string ident)
private function integer of_readarray (ref any varray, integer alevel)
private subroutine of_buildtreeofarray (any varray, long handle)
private function string of_getformatofarray (any varray, string ident)
public function integer getrootarray (ref any va[])
end prototypes

public function string parse (string as_json);json_pair pairsnull[]
pairs = pairsnull

is_json = as_json
ichars = as_json
imaxlen = len(as_json)
integer li_level = 0

idx = 0
skipspc()
if ichars[idx] = '{' then
	of_readobject(this, li_level)
elseif ichars[idx] = '[' then
	any la
	of_readarray(la, li_level)
	pairs[1].value = la
	//pairs[1].name = "root"
	this.pair_index += ";root=1"
end if


return ''
end function

public function integer getarray (string itemname, ref any va[]);any la

la = GetAttribute(itemname)

if isArray(la) then
	va= la
	return upperbound(va)
end if
return 0
end function

public function boolean isarray (any value);return classname(value)='any'
end function

public function any getattribute (string itemname);long index
if ignoreCase then
	itemname = upper(itemname)
end if
index = findpairindex(itemname)
if index = 0 then
	SignalError(42,"JSON.getAttribute: attribute "+string(itemname,"[general]")+" does not exists!")
	//return "!ERROR!"
	return ""
end if
return pairs[index].value
end function

private function integer of_readobject (sailjson vjson, integer alevel);//{....}
integer li_level , pairidx, arrayidx
string ls_name, ls_value
any la_value, la[], lanull[]
sailjson ljson

if ichars[idx] <> '{' then
	return -1
end if
li_level = alevel + 1
vjson.ilevel = li_level
skipspc()
do while idx < imaxlen
	//read key name, the first char is "
	if ichars[idx] = '"' then
		idx ++
		ls_name = ''
		ls_value = ''
		do while ichars[idx] <> '"'
			ls_name = ls_name + ichars[idx]
			idx++
		loop
		ski