升级inifile配置文件类，纯VFP代码

**************************************************
*-- Class Library:  d:\documents\visual foxpro 项目\inifile.vcx
**************************************************


**************************************************
*-- Class:        inifile (d:\documents\visual foxpro 项目\inifile.vcx)
*-- ParentClass:  custom
*-- BaseClass:    custom
*-- Time Stamp:   01/28/22 08:15:06 PM
*
DEFINE CLASS inifile AS custom


    Height = 61
    Width = 68
    *-- 保存新建或打开的ini文件名
    filename = ""
    *-- 保存新建ini文件的句柄。
    fhandle = 0
    *-- 保存ini文件的所有section对象的集合
    sections = .NULL.
    Name = "inifile"


    *-- 申明DLL函数
    PROCEDURE declaredlls
        *VB申明原型:;
        Public Declare Function GetPrivateProfileString;
        Lib "kernel32" Alias "GetPrivateProfileStringA" ;
        (ByVal lpApplicationName As String,;
        ByVal lpKeyName As Any, ;
        ByVal lpDefault As String, ;
        ByVal lpReturnedString As String, ;
        ByVal nSize As Long, ;
        ByVal lpFileName As String) As Long;
        读取INI文件指定块中的键名对应的字符串。
        Declare integer GetPrivateProfileString in win32api;
        String csection, ;
        string ckey, ;
        String cdefaultreturn, ;
        String cbuffer, ;
        integer nbuffersize, ;
        String cfile
         
        *VB申明原型:;
        Public Declare Function GetPrivateProfileSection ;
        Lib "kernel32" Alias "GetPrivateProfileSectionA" ;
        (ByVal lpAppName As String, ;
        ByVal lpReturnedString As String, ;
        ByVal nSize As Long, ;
        ByVal lpFileName As String) As Long;
        记取INI文件指定块中的所有键名及其对应值。
        DECLARE integer GetPrivateProfileSection in win32api;
        String csection, ;
        String cbuffer, ;
        integer nbuffersize, ;
        String cfile

        *VB申明原型:;
        Private Declare Function GetPrivateProfileSectionNames;
        Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" _;
        (ByVal lpszReturnBuffer As String, ;
        ByVal nSize As Long, ;
        ByVal lpFileName As String) As Long;
        读取一INI文件中所有的块名。
        Declare integer GetPrivateProfileSectionNames in win32api;
        String cbuffer, ;
        integer nsize, ;
        String cfile

        *VB申明原型:;
        Public Declare Function WritePrivateProfileString ;
        Lib "kernel32" Alias "WritePrivateProfileStringA" ;
        (ByVal lpApplicationName As String, ;
        ByVal lpKeyName As Any, ;
        ByVal lpString As Any, ;
        ByVal lpFileName As String) As Long
        DECLARE integer WritePrivateProfileString in win32api;
        string csection,;
        string ckey,;
        string cstring,; &&null值则删除此key
        string cfile

        *VB申明原型:;
        Public Declare Function WritePrivateProfileSection ;
        Lib "kernel32" Alias "WritePrivateProfileSectionA" ;
        (ByVal lpAppName As String, ;
        ByVal lpString As String, ;
        ByVal lpFileName As String) As Long
        DECLARE integer WritePrivateProfileSection in win32api;
        string csection,;
        string cstring,;&&用chr(0)间隔的字符串组,null值则删除此section
        string cfile
    ENDPROC


    *-- 建立一个ini文件
    PROCEDURE create
        PARAMETERS lcfilename
        IF PARAMETERS()=0
            lcfilename=PUTFILE('','myinifile1','ini')
        ENDIF
        IF lcfilename==''
            RETURN .f.
        ELSE
            this.fhandle=FCREATE(lcfilename,0)
            FCLOSE(this.fhandle)
            this.filename=lcfilename
            RETURN .t.
        ENDIF

    ENDPROC


    *-- 向ini文件写入一个section，如果指定的section不存在则新建一个section。
    PROCEDURE writesection
        *VB申明原型:;
        Public Declare Function WritePrivateProfileString ;
        Lib "kernel32" Alias "WritePrivateProfileStringA" ;
        (ByVal lpApplicationName As String, ;
        ByVal lpKeyName As Any, ;
        ByVal lpString As Any, ;
        ByVal lpFileName As String) As Long;
        DECLARE integer WritePrivateProfileString in win32api;
        string csection,;
        string ckey,;
        string cstring,; &&null值则删除此key;
        string cfile
        PARAMETERS lcsection,lckey,lcstring
        IF this.filename==""
            RETURN .f.
        ENDIF
        IF PARAMETERS()=0
            Lcparameter=INPUTBOX("请设置section名，key名，以及key值，用斜杠/分割","新建或写入一个section小节")
            IF EMPTY(lcparameter)
                RETURN .f.
            ENDIF
            lcsection=LEFT(ALLTRIM(lcparameter),AT("/",ALLTRIM(lcparameter),1)-1)

            lckey=SUBSTR(ALLTRIM(lcparameter), AT("/",ALLTRIM(lcparameter),1)+1, (AT("/",ALLTRIM(lcparameter),2)-AT("/",ALLTRIM(lcparameter),1)-1))

            lcstring=RIGHT(ALLTRIM(lcparameter),(LEN(ALLTRIM(lcparameter))-AT("/",ALLTRIM(lcparameter),2)))
        ENDIF

        writeprivateprofilestring(lcsection,lckey,lcstring,this.filename)

        cexact=SET("exact")
        SET EXACT ON
        *************2022/01/28用集合替代数组****************************;
        nfound=ASCAN(this.sections,lcsection);
        IF nfound=0;
            IF TYPE('this.sections[1]')<>"O";
                nlen=1;
            else    ;
                nlen=ALEN(this.sections)+1;
                DIMENSION this.sections[nlen];
            ENDIF     ;
            this.sections[nlen]=CREATEOBJECT("section");
            this.sections[nlen].name=lcsection;
            this.sections[nlen].writekey("lckey",'lcstring');
            this.sections[nlen].loadsection(lcsection);
            this.sections[nlen].filename=this.filename;
        ENDIF
        lexist=.f.
        FOR t=1 TO this.sections.count
            IF this.sections(t).name==ALLTRIM(lcsection)
                this.sections(t).writekey("lckey",'lcstring')
                lexist=.t.
                EXIT
            ENDIF
        ENDFOR

        IF lexist=.f.
            this.sections.add(CREATEOBJECT("section"))
            m=this.sections.count
            this.sections(m).name=ALLTRIM(lcsection)
            this.sections(m).writekey("lckey",'lcstring')
            this.sections(m).filename=this.filename
        ENDIF
        SET EXACT &cexact

        RELEASE lcparameter,lcsection,lckey,lcstring,cexact,lexist,m

        *************2022/01/28用集合替代数组****************************

        RETURN .t.

    ENDPROC


    *-- 导入ini文件
    PROCEDURE loadfile
        PARAMETERS lcinifile
        IF PARAMETERS()=0
            lcinifile=GETFILE('ini','选择ini文件','选择',0,'请选择要打开的ini文件')
            IF EMPTY(lcinifile)
                RETURN .f.
            ENDIF
            this.filename=lcinifile
        ENDIF

        lcbuffer=repli(CHR(0),255)
        lnsize=getprivateprofilesectionnames(@lcbuffer,255,lcinifile)
        *************导入一个空的ini文件时，系统报错*********************
        IF lnsize=0
            RETURN .f.
        ENDIF
        *************2021/10/15加入这段排错******************************
        *************2022/01/28用集合替代数组****************************
        lcbuffer=SUBSTR(lcbuffer,1,lnsize)
        lnarray=OCCURS(CHR(0),lcbuffer)
        DIMENSION laposition[lnarray]
        *DIMENSION this.sections[lnarray]
        FOR j=1 TO lnarray
            laposition[j]=AT(CHR(0),lcbuffer,j)
            n=IIF(j>1,laposition[j-1]+1,1)
            csection="section"+ALLTRIM(STR(J))
            &csection=CREATEOBJECT("section")
            this.sections.add(&csection,csection)
            this.sections.item(csection).name=SUBSTR(lcbuffer,n,laposition[j]-n)
            this.sections.item(csection).filename=this.filename
            this.sections.item(csection).loadsection()&&由于调用了这个方法，很多变量名重名，导致频繁报错，排查了好久。
        ENDFOR

        RELEASE lcinifile,lcbuffer,lnsize,lnarray,j,n,laposition

        RETURN .t.
    ENDPROC


    *-- 删除一个指定的section小节，及其数据。
    PROCEDURE deletesection
        *VB申明原型:;
        Public Declare Function WritePrivateProfileSection ;
        Lib "kernel32" Alias "WritePrivateProfileSectionA" ;
        (ByVal lpAppName As String, ;
        ByVal lpString As String, ;
        ByVal lpFileName As String) As Long;
        DECLARE integer WritePrivateProfileSection in win32api;
        string csection,;
        string cstring,;&&用chr(0)间隔的字符串组,null值则删除此section;
        string cfile
        PARAMETERS lcsection
        nchoice=MESSAGEBOX("此section小节下面的所有数据都会被删除！确定此操作吗？",1+48+256,"警告！")
        IF nchoice=1
            WritePrivateProfileSection(lcsection,NUll,this.filename)
            cexact=SET("exact")
            SET EXACT ON
        **********************用集合替代集合*******************;
            nfound=0
            FOR i=1 TO this.sections.count
                IF this.sections(i).name==ALLTRIM(lcsection)
                    this.sections.remove(i)
                    EXIT
                ENDIF
            ENDFOR
        *****************************************************;
            nlen=ALEN(this.sections);
            ADEL(this.sections,nfound);;
            IF nlen>1;
                DIMENSION this.sections[nlen-1];
            ENDIF
            SET EXACT &cexact
        **********************用集合替代集合*******************
            RETURN .t.
        ELSE
            RETURN .f.
        ENDIF

    ENDPROC


    PROCEDURE Destroy
        CLEAR DLLS
        RELEASE ALL
    ENDPROC


    PROCEDURE Init
        this.declaredlls()
        *IF ISNULL(this.sections)
            this.sections=CREATEOBJECT("sections")
        *ENDIF

    ENDPROC


ENDDEFINE
*
*-- EndDefine: inifile
**************************************************


**************************************************
*-- Class:        key (d:\documents\visual foxpro 项目\inifile.vcx)
*-- ParentClass:  custom
*-- BaseClass:    custom
*-- Time Stamp:   10/11/21 10:01:08 PM
*
DEFINE CLASS key AS custom


    Height = 58
    Width = 75
    *-- 用以保存指定section的key值
    value = ""
    Name = "key"


ENDDEFINE
*
*-- EndDefine: key
**************************************************


**************************************************
*-- Class:        keys (d:\documents\visual foxpro 项目\inifile.vcx)
*-- ParentClass:  collection
*-- BaseClass:    collection
*-- Time Stamp:   01/23/22 05:39:07 PM
*
DEFINE CLASS keys AS collection


    Height = 23
    Width = 23
    Name = "keys"


    PROCEDURE Add
        LPARAMETERS eItem, cKey, eBefore, eAfter
        ****以下代码将阻止添加其它非指定对象key的任何成员，只允许添加派生于key类的对象****
        **********感兴趣的朋友可以修改这段代码让自己的key类只添加符合条件的成员***********

        IF TYPE("eitem")#"O" &&阻止非对象成员添加
            NODEFAULT
            MESSAGEBOX("非法成员添加！",0+16,"错误",1000)
            RETURN .f.
        ELSE
            IF upper(eitem.class)#UPPER("key") &&阻止非Key对象的成员添加
                NODEFAULT
                MESSAGEBOX("非法成员添加！",0+16,"错误",1000)
                RETURN .f.
            ENDIF
        ENDIF

    ENDPROC


ENDDEFINE
*
*-- EndDefine: keys
**************************************************


**************************************************
*-- Class:        section (d:\documents\visual foxpro 项目\inifile.vcx)
*-- ParentClass:  custom
*-- BaseClass:    custom
*-- Time Stamp:   01/28/22 08:12:01 PM
*
DEFINE CLASS section AS custom


    Height = 24
    Width = 81
    *-- 保存ini文件名
    filename = ""
    *-- 用以保存section里所有key对象的集合
    keys = "NULL"
    Name = "section"


    *-- 载入指定section下的所有key以及key值，并保存在keys数组和values数组里
    PROCEDURE loadsection
        PARAMETERS lcsection
        IF PARAMETERS()=0
            lcsection=this.name
        ENDIF

        *这里的变量名都加了个数字1，是因为inifile类的loadfile调用了这个方法，导致变量重名出错。
        *单独运行没有问题，一旦被调用就出问题了，排查了很久。
        *现在所有变量名称后面都加了1，故障排除。
        *原来是用数组来保存keys数据，2021/1/28改为用集合来保存
        lcbuffer1=repli(CHR(0),255)
        lcinifile=this.filename
        lnsize1=getprivateprofilesection(lcsection,@lcbuffer1,255,lcinifile)
        IF lnsize1=0
            RETURN .f.
        ELSE
            lcbuffer1=SUBSTR(lcbuffer1,1,lnsize1)
        ENDIF
        **********************************原来的使用数组代码开始*************************************;
        lnarray1=OCCURS(CHR(0),SUBSTR(lcbuffer1,1,lnsize1));
        DIMENSION laposition1[lnarray1];
        DIMENSION this.keys[lnarray1];
        DIMENSION keyvalue[lnarray1];
        FOR i=1 TO lnarray1;
            laposition1[i]=AT(CHR(0),lcbuffer1,i);
            n1=IIF(i>1,laposition1[i-1]+1,1);
            keyvalue[i]=SUBSTR(lcbuffer1,n1,laposition1[i]-n1);
            this.keys[i]=CREATEOBJECT("key");
            this.keys[i].name=SUBSTR(keyvalue[i],1,AT("=",keyvalue[i],1)-1);
            this.keys[i].value=SUBSTR(keyvalue[i],AT("=",keyvalue[i],1)+1,LEN(keyvalue[i]));
        ENDFOR
        **********************************原来的使用数组代码结束*************************************

        **********************************现在的使用集合代码开始*************************************
        *this.keys.remove(-1) &&确保集合为空

        lnarray1=OCCURS(CHR(0),lcbuffer1)
        DIMENSION laposition1[lnarray1] &&保存key数据中间隔符chr(0)的位置的数组，以便提取keyvalue值
        DIMENSION keyvalue[lnarray1]
        FOR i=1 TO lnarray1
            laposition1[i]=AT(CHR(0),lcbuffer1,i)
            n1=IIF(i>1,laposition1[i-1]+1,1)
            keyvalue[i]=SUBSTR(lcbuffer1,n1,laposition1[i]-n1)
            ckey="key"+ALLTRIM(STR(i))
            &ckey=CREATEOBJECT("key")
            this.keys.add(&ckey,ckey)
            this.keys.item(ckey).name=SUBSTR(keyvalue[i],1,AT("=",keyvalue[i],1)-1)
            this.keys.item(ckey).value=SUBSTR(keyvalue[i],AT("=",keyvalue[i],1)+1,LEN(keyvalue[i]))
        ENDFOR
        RELEASE lnarray1,laposition1,keyvalue,i,n1,lcbuffer1
        **********************************现在的使用集合代码结束*************************************

        RETURN .t.
    ENDPROC


    *-- 向section小节指定的key写入值，如果指定的key不存在则新建一个。
    PROCEDURE writekey
        *VB申明原型:;
        Public Declare Function WritePrivateProfileString ;
        Lib "kernel32" Alias "WritePrivateProfileStringA" ;
        (ByVal lpApplicationName As String, ;
        ByVal lpKeyName As Any, ;
        ByVal lpString As Any, ;
        ByVal lpFileName As String) As Long;
        DECLARE integer WritePrivateProfileString in win32api;
        string csection,;
        string ckey,;
        string cstring,; &&null值则删除此key;
        string cfile
        PARAMETERS lckey,lcvalue

        IF PARAMETERS()=0
            Lcparameter=INPUTBOX("请设置key名，以及key值，用斜杠/分割","新建或修改一个key")
            IF EMPTY(lcparameter)
                RETURN .f.
            ENDIF
            lckey=LEFT(ALLTRIM(lcparameter),AT("/",ALLTRIM(lcparameter),1)-1)

            lcvalue=RIGHT(ALLTRIM(lcparameter),(LEN(ALLTRIM(lcparameter))-AT("/",ALLTRIM(lcparameter),1)))
        ENDIF

        writeprivateprofilestring(this.name,lckey,lcvalue,this.filename)

        cexact=SET("exact")
        SET EXACT ON
        **********************原来用数组来保存key*******************;
        nfound=ASCAN(this.keys,lckey);
        IF nfound=0;
            IF TYPE('this.keys[1]')<>"O";
                nlen=1;
            else    ;
                nlen=ALEN(this.keys)+1;
                DIMENSION this.keys[nlen];
            ENDIF;
        ENDIF;
        this.keys[nlen]=CREATEOBJECT("key");
        this.keys[nlen].name=lckey;
        this.keys[nlen].value=lcvalue;
        **********************现在用集合来保存key*******************
        lfound=.f.
        n=this.keys.count

        FOR EACH okey IN this.keys
            IF okey.name==ALLTRIM(lckey)
                lfound=.t. &&判断集合中是否已有该key对象
            ENDIF
        ENDFOR

        IF lfound=.f. &&没有该key对象则添加该对象
            this.keys.add(CREATEOBJECT("key"))
            n=n+1
            this.keys(n).name=lckey
        ENDIF

        this.keys(n).value=lcvalue
        **********************现在用集合来保存key*******************

        SET EXACT &cexact

        RETURN .t.
    ENDPROC


    *-- 删除指定key及其key值。
    PROCEDURE deletekey
        *VB申明原型:;
        Public Declare Function WritePrivateProfileString ;
        Lib "kernel32" Alias "WritePrivateProfileStringA" ;
        (ByVal lpApplicationName As String, ;
        ByVal lpKeyName As Any, ;
        ByVal lpString As Any, ;
        ByVal lpFileName As String) As Long;
        DECLARE integer WritePrivateProfileString in win32api;
        string csection,;
        string ckey,;
        string cstring,; &&null值则删除此key;
        string cfile
        PARAMETERS lckey
        nchoice=MESSAGEBOX("此key键下面的所有数据都会被删除！确定此操作吗？",1+48+256,"警告！")
        IF nchoice=1
            WritePrivateProfilestring(this.name,lckey,NUll,this.filename)
            cexact=SET("exact")
            SET EXACT ON
        **********************用集合替代集合*******************;
            nfound=0;
            FOR i=1 TO ALEN(this.keys);
                IF this.keys[i].name==lckey;
                    nfound=i;
                ENDIF;
            ENDFOR ;
            ;
            nlen=ALEN(this.keys);
            ADEL(this.keys,nfound)    ;
            IF nlen>1;
                DIMENSION this.sections[nlen-1];
            ENDIF

            FOR i=1 TO this.keys.count
                IF this.keys(i).name==ALLTRIM(lckey)
                    this.keys.remove(i)
                    EXIT
                ENDIF
            ENDFOR


        **********************用集合替代集合*******************
            SET EXACT &cexact
            RETURN .t.
        ELSE
            RETURN .f.
        ENDIF

    ENDPROC


    PROCEDURE Init
        *1/28日加入以下代码，将this.keys赋值为集合
        *IF ISNULL(this.keys)
            this.keys=CREATEOBJECT("keys")
        *ENDIF
    ENDPROC


ENDDEFINE
*
*-- EndDefine: section
**************************************************


**************************************************
*-- Class:        sections (d:\documents\visual foxpro 项目\inifile.vcx)
*-- ParentClass:  collection
*-- BaseClass:    collection
*-- Time Stamp:   01/23/22 05:42:00 PM
*
DEFINE CLASS sections AS collection


    Height = 23
    Width = 23
    Name = "sections"


    PROCEDURE Add
        LPARAMETERS eItem, cKey, eBefore, eAfter
        ****以下代码将阻止添加其它非指定对象section的任何成员，只允许添加派生于section类的对象****
        **********感兴趣的朋友可以修改这段代码让自己的collection类只添加符合条件的成员***********

        IF TYPE("eitem")#"O" &&阻止非对象成员的添加
            NODEFAULT
            MESSAGEBOX("非法成员添加！",0+16,"错误",1000)
            RETURN .f.
        ELSE
            IF upper(eitem.class)#UPPER("section") &&阻止非section的派生类对象的成员添加
                NODEFAULT
                MESSAGEBOX("非法成员添加！",0+16,"错误",1000)
                RETURN .f.
            ENDIF
        ENDIF

    ENDPROC


ENDDEFINE
*
*-- EndDefine: sections
**************************************************