升级inifile配置文件类，纯VFP代码
inifile.zip
(23.25 KB)
奉上源代码。
程序代码：**************************************************
*-- 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
**************************************************
