注册 登录
编程论坛 → VFP论坛

重新写的json解析类2025.03.24版，纯vfp代码，欢迎试错~

sam_jiang 发布于 2025-03-25 00:04， 217 次点击
之前用的是递归法解析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编辑过]

9 回复
#2
schtg2025-03-25 06:50
谢谢分享！
#3
easyppt2025-03-25 09:36
几万条记录的速度如何啊
\u的能解析吗
转义符能解析吗
#4
sam_jiang2025-03-25 09:50
foxjson类代码里有个单词拼写错误，parse写成了parser，感兴趣的自己修改一下!
上次群里有个兄弟发了个100KB的json结构挑战解析测试，这个版本可以应对~~~

只有本站会员才能查看附件，请 登录
#5
sam_jiang2025-03-25 09:54
回复 3楼 easyppt
没有考虑到转义字符的情况，我不太了解，一会百度一下看看转义字符有哪些？

目前将原封不动输出。

[此贴子已经被作者于2025-3-25 09:58编辑过]
#6
sam_jiang2025-03-25 09:57
ON ESCAPE cancel
PUBLIC ojson
cjsonstr=FILETOSTR("jsondata.txt")
?LEN(cjsonstr) && 显示104360
ojson=NEWOBJECT("foxjson","myclass")
time1=DATETIME()
ojson.parse(cjsonstr)
time2=DATETIME()
?time2-time1 &&显示1秒
#7
laowan0012025-03-25 20:49
这是个细活儿啊，赞赞赞！！！
#8
easyppt2025-03-26 10:54
解析有点不太合理，应该是：
1、属性 对应 属性
2、数组  对 数组

你现在是 所有的对象都解析成二维数组了 感觉挺奇怪的。
建议参考一下瓜哥的解析思路，用empty对象 表示属性 ， collection集合 表示 数组

当然 性能是否有影响，就不太清楚了。

各有利弊吧，数组也不是不可以



[此贴子已经被作者于2025-3-26 10:55编辑过]
#9
sam_jiang2025-03-26 12:32
回复 8楼 easyppt
都是为了提升速度啊，考虑到用数组速度快，所以构建了数组类jsonarray。
另外，json对象其实就是键值对集合，所以就构建一个二维数组keyvalue类，json类就继承于这个二维数组类。
对于jsonarray类，我设计了一些方法，以便向访问数组一样访问json数组元素；
对于json类，我设计了一些类似类似collection类的方法，以便像访问collection类一样访问。
这个解析器，可以访问复杂json结构中任意层次的key，value，非常方便。
我本来也想参考瓜哥的解析思路，用空对象，但是空对象无法继承，且没有方法，感觉挺麻烦，放弃了。

后续，我再把json类和jsonarray类的array[]属性设置为只读，或保护，防止用户直接更改array数据，那样可能更完美！
考虑到这个层次结构和treeview很类似，正在构思加入一些类似treeview的方法进去。。。

[此贴子已经被作者于2025-3-26 13:02编辑过]
#10
easyppt2025-03-27 08:30
VFP数组都比较熟悉，挺好的！

[此贴子已经被作者于2025-3-27 08:42编辑过]
1
©2025, BC-CN.NET
电脑版