PB创建XML解析函数

 

XML解析函数
类型：nonvisualobject
名称：sailjson
edit source：

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 = true  
    integer ilevel  
    string pair_index  
  
//end variab
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 ++