纯vfp代码json类2024.12.29版

**************************************************
*-- 类:           json (d:\documents\visual foxpro 项目\myclass.vcx)
*-- 父类:  collection
*-- 基类:    collection
*-- 时间戳:   12/29/24 05:14:14 PM
*
DEFINE CLASS json AS collection


    Height = 23
    Width = 23
    *-- 生成的json脚本
    jsscript = ""
    Name = "json"


    *-- 返回json结构中指定属性的值。
    PROCEDURE getvalue
        PARAMETERS ckey,noccurrence
        LOCAL i,j,nleft,nright,cchar,cvalue,n
        cvalue=""

        IF PARAMETERS()=1
            noccurrence=1
        ENDIF

        n=AT(ckey,this.jsscript,noccurrence)
        IF n>0
            *!* 确定指定json属性的值的起始位置
            nleft=n+LEN(ckey)
            DO WHILE .t.
                nleft=nleft+1
                cchar=SUBSTR(this.jsscript,nleft,1)
                IF cchar=":"
                    nleft=nleft+1 &&从":"后面一个字符开始
                    EXIT
                ELSE
                    LOOP
                ENDIF
            ENDDO
            *!*
            DO WHILE .t.
                cchar=ALLTRIM(SUBSTR(this.jsscript,nleft,1))
                IF cchar=" " &&空格，冒号后面可能不小心输入了空格，剔除它
                    nleft=nleft+1
                    LOOP
                ELSE
                    EXIT
                ENDIF
            ENDDO

            IF cchar="[" &&说明是数组
                *!*确定与"["匹配的"]"的位置
                i=0
                DO WHILE .t.
                    i=i+1
                    nright=AT("]",this.jsscript,i)
                    IF nright<nleft
                        LOOP
                    ELSE
                        cvalue=SUBSTR(this.jsscript,nleft,nright-nleft+1)
                        IF OCCURS("[",cvalue)=OCCURS("]",cvalue)
                            EXIT
                        ELSE
                            LOOP
                        ENDIF
                    ENDIF
                ENDDO
            ELSE &&否则就是普通数值
                *!* 亦有可能是json嵌套，2024/12/22 加入json嵌套解读代码
                IF cchar="{" &&说明值是一个json结构，然后找出“}”的位置
                    nright=nleft
                    DO WHILE .t.
                        nright=nright+1
                        cchar=SUBSTR(this.jsscript,nright,1)
                        IF cchar="}"
                            cvalue=SUBSTR(this.jsscript,nleft,nright-nleft+1)
                            EXIT
                        ELSE
                            LOOP
                        ENDIF

                    ENDDO
                ELSE &&然后才是普通数值
                    cscript=this.jsscript+","
                    j=0
                    DO WHILE .t.
                        j=j+1
                        nright=AT(",",cscript,j)
                        IF nright<nleft
                            LOOP
                        ELSE
                            cvalue=SUBSTR(cscript,nleft,nright-nleft)
                            cvalue=STRTRAN(cvalue,["],"")
                            cvalue=STRTRAN(cvalue,[}],"")
                            cvalue=ALLTRIM(cvalue)
                            *!* 12/28加入，复原可能的“:”“,”
                            cvalue=STRTRAN(cvalue,",",",") &&复原逗号
                            cvalue=STRTRAN(cvalue,":",":") &&复原冒号
                            *!* 12/29加入，复原可能的“[]”“{}”
                            cvalue=STRTRAN(cvalue,"[","[") &&复原左中括号
                            cvalue=STRTRAN(cvalue,"]","]") &&复原右中括号
                            cvalue=STRTRAN(cvalue,"{","{") &&复原左大括号
                            cvalue=STRTRAN(cvalue,"}","}") &&复原右大括号
                            *!*
                            EXIT
                        ENDIF
                    ENDDO
                ENDIF
                *!*
            ENDIF
        ENDIF

        RETURN cvalue
    ENDPROC


    *-- 解析json结构。
    PROCEDURE parse
        LPARAMETERS jsonscript
        *!* 12/28发现bug，当json属性的值里有“:”“,”符号时，解析程序出错
        *!* 解决方案，解析前搜索每对引号对，把这两个字符替换掉，最后再复原。
        LOCAL ckey,cstr,i,ii,j,n,ccontent,ckey,cvalue,atemp,nleft,nright,jsarray,ncount,m
        jsonscript=STRTRAN(jsonscript,CHR(9),"") &&清除tab键
        jsonscript=STRTRAN(jsonscript,CHR(10),"") &&清除ctrl+enter
        jsonscript=STRTRAN(jsonscript,CHR(13),"") &&清除换行符
        jsonscript=allt(jsonscript) &&清除首尾空格
        *!*    ************最基本的json结构检查************
        IF OCCURS("{",jsonscript)<>OCCURS("}",jsonscript) OR OCCURS("[",jsonscript)<>+OCCURS("]",jsonscript) OR MOD(OCCURS(["],jsonscript),2)<>0
            MESSAGEBOX('{,[" 未成对！')
            RETURN .f.
        ENDIF
        *!* 12/28修改，加入代码完成对“:”(:)“,”(,)字符的判断并替换
        ncount=0
        n=OCCURS(["],jsonscript)
        FOR i=1 TO n/2
            ccontent=STREXTRACT(jsonscript,["],["],2*i-1)
            ctemp=ccontent
            *!* 12/28 替换“:”
            ncount=OCCURS([:],ctemp)
            IF ncount<>0
                ctemp=STRTRAN(ctemp,[:],":")
            ENDIF
            *!*
            *!* 替换“,”
            *ccontent=STREXTRACT(jsonscript,["],["],2*i-1)
            ncount=OCCURS([,],ctemp)
            IF ncount<>0
                ctemp=STRTRAN(ctemp,[,],",")
            ENDIF
            *!* 12/28
            *!* 12/29*!* 替换“[”
            ncount=OCCURS("[",ctemp)
            IF ncount<>0
                ctemp=STRTRAN(ctemp,"[","[")
            ENDIF
            *!*
            *!* 替换“]”
            ncount=OCCURS("]",ctemp)
            IF ncount<>0
                ctemp=STRTRAN(ctemp,"]","]")
            ENDIF
            *!*
            *!* 替换“{”
            ncount=OCCURS([{],ctemp)
            IF ncount<>0
                ctemp=STRTRAN(ctemp,[{],"{")
            ENDIF
            *!*
            *!* 替换“}”
            ncount=OCCURS([}],ctemp)
            IF ncount<>0
                ctemp=STRTRAN(ctemp,[}],"}")
            ENDIF
            *!* 12/29 *!*
            jsonscript=STRTRAN(jsonscript,ccontent,ctemp)
        ENDFOR
        *!*

        this.jsscript=jsonscript
        *****
        *!* 先检查是不是包含json数组的复合结构
        *!* 提取所有json数组，并以AJSON+编号予以替换，保存于jsonarraylist中
        n=0
        DO WHILE .t.
            IF OCCURS("[",jsonscript)>0 &&说明json结构里有数组
                DIMENSION jsonarraylist[n+1] &&用以保存json数组的内容
                nleft =AT("[",jsonscript) &&确定第一个 "[" 的位置
                i=0
                *!*  下面这段代码确定与第一个 "[" 匹配的 "]" 的位置
                DO WHILE .t.
                    i=i+1
                    nright=AT("]",jsonscript,i)
                    ccontent=SUBSTR(jsonscript,nleft,nright-nleft+1)
                    IF OCCURS("[",ccontent)<>OCCURS("]",ccontent)
                        LOOP
                    ELSE
                        EXIT
                    ENDIF
                ENDDO
                *!*
        *!*            ccontent=SUBSTR(jsonscript,nleft,nright-nleft+1) &&提取json数组的整体内容
                n=n+1
                jsarray="AJSON_"+TRANSFORM(n) &&准备替换掉数组的内容
                jsonscript=STRTRAN(jsonscript,ccontent,jsarray)
                jsonarraylist(n)=ccontent
                LOOP
            ELSE
                *!* 2024/12.22 漏掉一种可能，没有数组，但是有json嵌套
                IF OCCURS("{",jsonscript)>1
                    DIMENSION jsonarraylist[n+1]
                    nleft=AT("{",jsonscript,2)
                    nright=AT("}",jsonscript,1)
                    ccontent=SUBSTR(jsonscript,nleft,nright-nleft+1)
                    n=n+1
                    jsarray="OJSON_"+TRANSFORM(n)
                    jsonscript=STRTRAN(jsonscript,ccontent,jsarray)
                    jsonarraylist(n)=ccontent
                    loop
                ELSE
                    EXIT
                ENDIF
                *!*
            ENDIF
        ENDDO
        *!*

        *!* 对替换所有数组后的json结构进行解析
        DIMENSION atemp[1]
        ncount=ALINES(atemp,jsonscript,9,",")
        FOR i=1 TO ncount
            ckey  =ALLTRIM(STREXTRACT(STREXTRACT(atemp[i],"",":"),["],["]))
            cvalue=STRtr(STREXTRACT(atemp[i],":",""),["],[])
            cvalue=ALLTRIM(STRTRAN(cvalue,"}",""))
            *!* 12/28加入，复原可能存在的“：”，“，”
            cvalue=STRTRAN(cvalue,",",[,])
            cvalue=STRTRAN(cvalue,":",[:])
            *!* 12/29加入，复原可能存在的“[]”，“{}”
            cvalue=STRTRAN(cvalue,"[","[") &&复原左中括号
            cvalue=STRTRAN(cvalue,"]","]") &&复原右中括号
            cvalue=STRTRAN(cvalue,"{","{") &&复原左大括号
            cvalue=STRTRAN(cvalue,"}","}") &&复原右大括号
            *!*
            *!* 12/29加入对数据类型的分析
            *!*    12/29 发现bug，生成的json值不只是文本，还有其他的数据类型，所以。。。
            *!*    上网查了一下，JSON 值可以是：
            *!*    1,数字（整数或浮点数）
            *!*    2,字符串（在双引号中）
            *!*    3,逻辑值（true 或 false）
            *!*    4,数组（在中括号中）
            *!*    5,对象（在大括号中）
            *!*    6,null
            DO CASE
                CASE LOWER(cvalue)="true" &&json逻辑值真
                    cvalue=.T.
                CASE LOWER(cvalue)="flase" &&json逻辑值假
                    cvalue=.f.
                CASE LOWER(cvalue)="null" &&json null值
                    cvalue=null
                CASE ISDIGIT(cvalue)=.t. &&首字母是数字，我们就需要判断cvalue是否为json的数值型数据
                    IF OCCURS(".",cvalue)<2 &&如果数字字符串里有超过2个“.”,说明不是数字，比如网址
                        *!* 比循环更简便的算法
                        ctemp=cvalue
                        ctemp=CHRTRAN(cvalue,"0123456789.","") &&替换掉所有数字字符和小数点
                        IF LEN(ctemp)=0 &&说明是数字，并没有其他字符
                            noldset=SET("Decimals")
                            ndotpos=AT(".",cvalue)
                            IF ndotpos=0
                                SET DECIMALS TO ndotpos
                            ELSE
                                SET DECIMALS TO len(cvalue)-ndotpos
                            ENDIF
                            cvalue=VAL(cvalue)
                            SET DECIMALS TO noldset
                        ENDIF
                    *!*
                    ENDIF
            ENDCASE
            *!*
            this.Add(cvalue,ckey)
        ENDFOR
        *!*

        *!*    *!* 如果是复合结构，则复原json数组内容
        *!*    IF VARTYPE(jsonarraylist)!="U"
        *!*        FOR i=1 TO ALEN(jsonarraylist)
        *!*            cvalue="AJSON_"+TRANSFORM(i)
        *!*            FOR j=1 TO this.count
        *!*                IF TRANSFORM(this.Item(j))=cvalue
        *!*                    ckey=this.GetKey(j)
        *!*                    this.Remove(ckey)
        *!*                    this.add(jsonarraylist[i],ckey)
        *!*                ENDIF
        *!*            ENDFOR

        *!*        ENDFOR
        *!*    ENDIF
        *!*    *!*
        *!* 如果是复合结构，则复原json数组内容
        IF VARTYPE(jsonarraylist)!="U"
            FOR i=1 TO ALEN(jsonarraylist)
                cvalue="AJSON_"+TRANSFORM(i)
                m=this.count
                FOR j=1 TO m
                    IF TRANSFORM(this.Item(j))=cvalue
                        ckey=this.GetKey(j)
                        this.Remove(ckey)
                        &ckey=NEWOBJECT([jsonarray],[myclass])
                        &ckey..name=ckey
                        &ckey..parse(jsonarraylist[i])
                        IF j=m
                            this.add(&ckey,ckey)
                        ELSE
                            this.Add(&ckey,ckey,j)
                        ENDIF
                    ENDIF
                ENDFOR
            ENDFOR

            FOR i=1 TO ALEN(jsonarraylist)
                cvalue="OJSON_"+TRANSFORM(i)
                m=this.count
                FOR j=1 TO m
                    IF TRANSFORM(this.Item(j))=cvalue
                        ckey=this.GetKey(j)
                        this.Remove(ckey)
                        &ckey=NEWOBJECT([json],[myclass])
                        &ckey..name=ckey
                        &ckey..parse(jsonarraylist[i])
                        IF j=m
                            this.add(&ckey,ckey)
                        ELSE
                            this.Add(&ckey,ckey,j)
                        ENDIF
                    ENDIF
                ENDFOR
            ENDFOR

        ENDIF
        *!*
    ENDPROC


    *-- 生成json脚本
    PROCEDURE generate
        *!*    12/29 发现bug，生成的json值不只是文本，还有其他的数据类型，所以。。。
        *!*    上网查了一下，JSON 值可以是：
        *!*    1,数字（整数或浮点数）
        *!*    2,字符串（在双引号中）
        *!*    3,逻辑值（true 或 false）
        *!*    4,数组（在中括号中）
        *!*    5,对象（在大括号中）
        *!*    6,null

        LOCAL cscript,ckey,cvalue,oref,i
        cscript=""
        IF this.Count>0
            FOR i=1 TO this.Count
                ckey=this.GetKey(i)
                IF VARTYPE(this.Item(i))="O"
                    oref=this.Item(i)
                    cvalue=oref.generate()
                ELSE
                    cvalue=this.Item(i)
                ENDIF
                *!* 12/29加入对值的类型判断
                DO CASE
                    CASE VARTYPE(cvalue)="N" && 如果该值是数字
                        cscript=cscript+["]+ckey+[":]+TRANSFORM(cvalue)+","
                    CASE VARTYPE(cvalue)="L" && 如果该值是逻辑值
                        cscript=cscript+["]+ckey+[":]+IIF(cvalue=.t.,"true","flase")+","
                    CASE VARTYPE(cvalue)="X" && 如果该值是null
                        cscript=cscript+["]+ckey+[":]+"null"+","
                    OTHERWISE
                        cscript=cscript+["]+ckey+[":]+IIF(INLIST(LEFT(TRANSFORM(cvalue),1),"[",[{]),TRANSFORM(cvalue),["]+TRANSFORM(cvalue)+["])+","
                ENDCASE
                *!*
            ENDFOR
            cscript=[{]+SUBSTR(cscript,1,LEN(cscript)-1)+[}]
        ENDIF
        this.jsscript=cscript
        RETURN this.jsscript
    ENDPROC


ENDDEFINE
*
*-- EndDefine: json
**************************************************

CLEAR
RELEASE ALL
PUBLIC ojson
ojson=NEWOBJECT("json")
ojson.Add(.t.,"sex")
ojson.Add(null,"isnull")
ojson.Add(123.36,"num")
ojson.add("adsfasdf","text")
ojson.Add({^2024/12/29},"date")
?ojson.generate()
cscript=ojson.generate()
ojson.Remove(-1)
ojson.parse(cscript)
?ojson.generate()