重新写的json解析类2025.03.24版,纯vfp代码,欢迎试错~
之前用的是递归法解析json结构,发现遇到复杂的,大型的json结构会导致运行速度太慢。。。现在改用迭代法解析json结构,感觉速度提升了不少,而且代码量也少了。刚写好,自己略作尝试,好像没什么问题,当然还需要压力测试,希望感兴趣的foxer拿去做测试,看看有没有bug?
新版本加入了level,和path,方便user快速定位复合json结构里的某个json节点
foxjson代码如下:

************************************************** *-- 类: foxjson (d:\documents\visual foxpro 项目\myclass.vcx) *-- 父类: keyvalue (d:\documents\visual foxpro 项目\myclass.vcx) *-- 基类: custom *-- 时间戳: 03/24/25 11:42:02 PM * DEFINE CLASS foxjson AS keyvalue *-- 记录json结构的层次深度。 level = 1 *-- 记录json结构的路径。 path = "" Name = "foxjson" *-- 解析json结构 PROCEDURE parse PARAMETERS cjsonstr *预处理json字符串,剔除前后空格,制表符,换行符以及回车符 SET EXACT ON LOCAL lnendpos,cvalue,n,cchar cjsonstr=ALLTRIM(cjsonstr) cjsonstr=CHRTRAN(cjsonstr,CHR(9)+CHR(10)+CHR(13),"") DO WHILE .t. IF ALLTRIM(cjsonstr)=="}" OR EMPTY(cjsonstr) EXIT ENDIF LOCAL lnendpos lnendpos=AT(["],cjsonstr,2)+1 IF lnendpos=1 RETURN ENDIF ckey=STREXTRACT(cjsonstr,["],["]) cjsonstr=SUBSTR(cjsonstr,lnendpos) cjsonstr=LTRIM(cjsonstr,1," ",":") cchar=LEFT(cjsonstr,1) DO CASE CASE cchar="[" &&数组 n=0 DO WHILE .t. n=n+1 lnendpos=AT("]",cjsonstr,n) cvalue=SUBSTR(cjsonstr,1,lnendpos) IF OCCURS("[",cvalue)>n LOOP ELSE cjsonstr=SUBSTR(cjsonstr,lnendpos+1) *下面解析cvalue,此时是数组 &ckey=NEWOBJECT("jsonarray","myclass") this.Append(ckey,&ckey) &ckey..level=this.level+1 &ckey..path=this.path+"/"+ckey+"("+TRANSFORM(this.count)+")" &ckey..parse(cvalue) EXIT ENDIF ENDDO CASE cchar="{" &&json结构 n=0 DO WHILE .t. n=n+1 lnendpos=AT("}",cjsonstr,n) cvalue=SUBSTR(cjsonstr,1,lnendpos) IF OCCURS("{",cvalue)>n LOOP ELSE cjsonstr=SUBSTR(cjsonstr,lnendpos+1) *下面解析cvalue,此时是json结构 &ckey=NEWOBJECT("foxjson","myclass") this.Append(ckey,&ckey) &ckey..level=this.level+1 &ckey..path=this.path+"/"+ckey+"("+TRANSFORM(this.count)+")" &ckey..parser(cvalue) EXIT ENDIF ENDDO CASE cchar=["] &&字符串 lnendpos=AT(["],cjsonstr,2) cvalue=STREXTRACT(cjsonstr,["],["]) cjsonstr=SUBSTR(cjsonstr,lnendpos+1) OTHERWISE &&数字,true,flase,null lnendpos=AT(",",cjsonstr) IF lnendpos=0 lnendpos=AT("}",cjsonstr) ENDIF cvalue=ALLTRIM(SUBSTR(cjsonstr,1,lnendpos-1)) DO CASE CASE UPPER(cvalue)=="TRUE" cvalue=.t. CASE UPPER(cvalue)=="FLASE" cvalue=.f. CASE UPPER(cvalue)=="NULL" cvalue=.null. CASE LEN(CHRTRAN(cvalue,"0123456789.eE+-",""))=0 cvalue=EVALUATE(cvalue) ENDCASE cjsonstr=SUBSTR(cjsonstr,lnendpos+1) ENDCASE IF INLIST(VARTYPE(cvalue),"L","N","X","I") OR (VARTYPE(cvalue)="C" AND !INLIST(LEFT(cvalue,1),"{","[")) this.append(ckey,cvalue) ENDIF LOOP ENDDO ENDPROC *-- 解析json数组。 PROCEDURE parsearray ENDPROC ENDDEFINE * *-- EndDefine: foxjson **************************************************
jsonarray代码如下:

************************************************** *-- 类: jsonarray (d:\documents\visual foxpro 项目\myclass.vcx) *-- 父类: custom *-- 基类: custom *-- 时间戳: 03/24/25 11:41:04 PM * DEFINE CLASS jsonarray AS custom *-- Jsonarray数组成员数量。 count = 0 *-- json数组脚本 script = "" *-- 记录json数组所在层级。 level = 1 *-- 记录json数组在json结构中的路径。 path = "" Name = "jsonarray" *-- Jsonarray数组 DIMENSION array[1] *-- 添加数组成员。 PROCEDURE add LPARAMETERS eExpr this.count= this.count + 1 dimension this.array[this.count] this.array[this.count] = eExpr return ENDPROC *-- 访问数组成员。 PROCEDURE item LPARAMETERS n return this.array[n] ENDPROC *-- 移除数组成员。 PROCEDURE remove LPARAMETERS eExpr IF TYPE(eExpr)="N" AND BETWEEN(eExpr,1,this.count) ADEL(this.array,eExpr) IF this.count>1 DIMENSION this.array(this.count-1) ENDIF this.count=this.count-1 ELSE n=ASCAN(this.array,eExpr) IF n!=0 ADEL(this.array,n) IF this.count>1 DIMENSION this.array(this.count-1) ENDIF this.count=this.count-1 ENDIF ENDIF ENDPROC *-- 清空数组。 PROCEDURE clear DIMENSION this.array[1] this.array[1]=.f. this.count=0 ENDPROC *-- 生成json数组文本。 PROCEDURE generate LOCAL oref,cvalue,i,cexpression cexpression="" IF this.count<>0 FOR i=1 TO this.count IF VARTYPE(this.item(i))="O" oref=this.item(i) cvalue=oref.generate() ELSE cvalue=TRANSFORM(this.item(i)) ENDIF IF [{] $ cvalue cexpression=cexpression+cvalue+[,] ELSE cexpression=cexpression+["]+cvalue+["]+[,] ENDIF ENDFOR IF cexpression=[""] cexpression="[]" ELSE cexpression="["+LEFT(cexpression,LEN(cexpression)-1)+"]" ENDIF ELSE cexpression="[]" ENDIF this.script=cexpression RETURN this.script ENDPROC *-- 从已知数组复制。 PROCEDURE copy PARAMETERS carrayname *调用该方法时数组变量参数前需加强制引用符号@ n=ALEN(carrayname) DIMENSION this.array(n) FOR i=1 TO n this.array(i)=carrayname(i) ENDFOR this.count=n ENDPROC *-- 设置数组项的值。 PROCEDURE set PARAMETERS nindex,eExpr this.array[nindex]=eExpr ENDPROC *-- 解析json数组 PROCEDURE parse PARAMETERS cArrayStr LOCAL cChar,lnEndPos,n,cobj SET EXACT ON carraystr=ALLTRIM(CHRTRAN(carraystr,CHR(9)+CHR(10)+CHR(13),"")) DO WHILE .t. IF INLIST(ALLTRIM(carraystr),"","}","]","}]") EXIT ENDIF cChar=SUBSTR(cArrayStr,2,1) DO CASE CASE cchar="{" && 嵌套json结构 n=0 DO WHILE .t. n=n+1 lnEndPos=AT("}",carraystr,n) eElement=SUBSTR(carraystr,2,lnEndPos-1) IF OCCURS("{",eElement)>n LOOP ELSE obj=SYS(2015) &obj=NEWOBJECT("foxjson","myclass") this.add(&obj) &obj..level=this.level+1 &obj..path=this.path+"/"+"item("+TRANSFORM(this.count)+")" &obj..parse(eelement) carraystr=SUBSTR(carraystr,lnendpos+1) EXIT ENDIF ENDDO CASE cchar="[" && 嵌套数组 n=0 DO WHILE .t. n=n+1 lnEndPos=AT("]",carraystr,n) eElement=SUBSTR(carraystr,2,lnEndPos-1) IF OCCURS("[",eElement)>n LOOP ELSE arr=SYS(2015) &arr=NEWOBJECT("jsonarray","myclass") this.add(&obj) &arr..level=this.level+1 &arr..path=this.path+"/"+"item("+TRANSFORM(this.count)+")" &arr..parse(eelement) carraystr=SUBSTR(carraystr,lnendpos+1) EXIT ENDIF ENDDO CASE cchar=["] && 字符串 eelement=STREXTRACT(carraystr,["],["]) lnEndPos=AT(["],carraystr,2) carraystr=SUBSTR(carraystr,lnendpos+1) CASE cchar=SPACE(1) && 可能是用户无意中输入的空格 carraystr=","+LTRIM(SUBSTR(carraystr,2)) LOOP OTHERWISE && 就是普通数据 lnendpos=AT(",",carraystr) IF lnendpos=1 lnendpos=AT(",",carraystr,2) ENDIF IF lnendpos=0 lnendpos=AT("]",carraystr) ENDIF eelement=LTRIM(chrtr(SUBSTR(carraystr,1,lnendpos-1),"[,","")) DO CASE CASE UPPER(eelement)=="NULL" eelement=.null. CASE UPPER(eelement)=="TRUE" eelement=.t. CASE UPPER(eelement)=="FLASE" eelement=.f. CASE LEN(CHRTRAN(eelement,"0123456789.eE+-",""))=0 AND !EMPTY(eelement) eelement=EVALUATE(eelement) ENDCASE carraystr=SUBSTR(carraystr,lnendpos) ENDCASE IF INLIST(VARTYPE(eelement),"L","X","N","I") or (VARTYPE(eelement)="C" AND !INLIST(LEFT(eelement,1),"[","{")) this.add(eelement) ENDIF LOOP ENDDO ENDPROC ENDDEFINE * *-- EndDefine: jsonarray **************************************************
foxjson的基类代码如下:

************************************************** *-- 类: keyvalue (d:\documents\visual foxpro 项目\myclass.vcx) *-- 父类: custom *-- 基类: custom *-- 时间戳: 03/24/25 10:20:09 PM * DEFINE CLASS keyvalue AS custom *-- 包含键值对的数量 count = 0 *-- 允许修改只读属性的方法名。 revisor = "" Name = "keyvalue" *-- 保存键值对数组 DIMENSION array[1,2] *-- 添加键值对。 PROCEDURE append PARAMETERS ckey,evalue this.revisor="append" &&设置修改只读属性count的方法名 IF this.count=0 this.array[1,1]=ckey this.array[1,2]=evalue this.count=this.count+1 ELSE IF ASCAN(this.array,ckey,1,this.count,1,9)>0 this.set(ckey,evalue) ELSE DIMENSION this.array[this.count+1,2] this.array[this.count+1,1]=ckey this.array[this.count+1,2]=evalue this.count=this.count+1 ENDIF ENDIF ENDPROC *-- 删除键值对 PROCEDURE delete PARAMETERS ckey this.revisor="delete" &&设置修改只读属性count的方法名 nrow=ASCAN(this.array,ckey,1,this.count,1,9) IF nrow>0 IF this.count>1 ADEL(this.array,nrow) DIMENSION this.array(this.count-1,2) ELSE STORE .f. TO this.array ENDIF this.count=this.count-1 RETURN .t. ENDIF RETURN .f. ENDPROC *-- 设置指定key的值 PROCEDURE set PARAMETERS ckey,evalue nrow=ASCAN(this.array,ckey,1,this.count,1,9) IF nrow>0 this.array[nrow,2]=evalue ENDIF ENDPROC *-- 访问键值对成员的值 PROCEDURE item LPARAMETERS eIndex DO CASE CASE VARTYPE(eindex)="N" IF eindex<=this.count AND eindex>0 RETURN this.array[eindex,2] ENDIF OTHERWISE nrow=ASCAN(this.array,eindex,1,this.count,1,9) IF nrow>0 RETURN this.array[nrow,2] ENDIF ENDCASE RETURN "" ENDPROC *-- 返回键名 PROCEDURE getkey LPARAMETERS nIndex IF BETWEEN(nindex,1,this.count) RETURN this.array[nindex,1] ENDIF RETURN "" ENDPROC PROCEDURE count_assign LPARAMETERS vNewVal *To do: 为 Assign 方法程序修改此例程 m.voldval=this.count IF INLIST(this.revisor,"append","delete") &&值允许这2个方法修改此值 THIS.count = m.vNewVal this.revisor="" ELSE this.count = m.voldval ENDIF ENDPROC *-- 生成键值对字符串 PROCEDURE script ENDPROC ENDDEFINE * *-- EndDefine: keyvalue **************************************************
测试代码1如下:
在调试窗口,看ojson,解析非常成功。。。

*********jsontest1.prg PUBLIC cjscript,ojson CLEAR cjscript='' SET TEXTMERGE TO memvar cjscript noshow \ { \ "test":123, \ "button":[ \ { \ "type":"click", \ "name":"今日歌曲", \ "key":"V1001_TODAY_MUSIC", \ "array":[111,"aaa","bbb"] \ }, \ { \ "name":"菜单", \ "sub_button":[ \ { \ "type":"view", \ "name":"搜索", \ "url":"http://www.\ }, \ { \ "type":"miniprogram", \ "name":"wxa", \ "url":"http://mp.weixin., \ "appid":"wx286b93c14bbf93aa", \ "pagepath":"pages/lunar/index" \ }, \ { \ "type":"click", \ "name":"赞一下我们", \ "key":"V1001_GOOD" \ }], \ "test":[111,222,333] \ }], \ "additive":"123456" \ } SET TEXTMERGE TO ojson=NEWOBJECT("foxjson","myclass") ojson.parse(cjscript)
测试代码2如下:
调试窗口看oarr,解析也很成功!

*************jsonarraytest2.prg ON ESCAPE cancel CLEAR SET TEXTMERGE TO memvar carraystr noshow \[111,1234,"test",true, \ { \ "type":"click", \ "name":"今日歌曲", \ "key":"V1001_TODAY_MUSIC", \ "array":[111,"aaa","bbb"] \ }, \ { \ "name":"菜单", \ "sub_button":[ \ { \ "type":"view", \ "name":"搜索", \ "url":"http://www.\ }, \ { \ "type":"miniprogram", \ "name":"wxa", \ "url":"http://mp.weixin., \ "appid":"wx286b93c14bbf93aa", \ "pagepath":"pages/lunar/index" \ }, \ { \ "type":"click", \ "name":"赞一下我们", \ "key":"V1001_GOOD" \ }], \ "test":[111,222,333] \ }] SET TEXTMERGE TO ?carraystr PUBLIC oarr oarr=NEWOBJECT("jsonarray","myclass") oarr.parser(carraystr)
[此贴子已经被作者于2025-3-25 00:07编辑过]