5,392
社区成员
发帖
与我相关
我的任务
分享
unit Unit2;
{*******************************************************************************
作者:零点
QQ: 32049916
功能:程序配置单元,自动装载程序目录下的 config.ini 或 option.dll 或 程序名.ini
实现了简单的数据表功能,下面是数据表的格式,=前边为id,=后边不能再有id字段
[TableName]
0001=cid:13,name:奥迪,html:<html>#1789abcd#1</html>
0005=cid:14,name:宝马,html:789abcd#1 ;id:0005,cid:14,name:宝马,html:789...
说明:每行中;后的所有内容都作为注释
Key中只能包含字母数字及.-字符
Value中的特殊字符为:#0=‘#’ #1=回车 #2=':' #3=',' #4=' ' #5='=' #6=';'
使用:在uses部分引用本单元,然后在代码中可以直接调用 config.GetStr
也可以装载自己的配置文件 config.reset('my.ini');
*******************************************************************************}
interface
uses Classes, Forms, SysUtils, DBClient, DB;
type
TConfig = class(TObject)
fFile: TStringList;
fIniFile: string;
function GetStr(const key: string; sTable:string):string;
function GetTable(sTable:string):TStringList;
function GetDataSet(sTable:string):TClientDataSet;
function GetDataByWhere(whereKey,whereValue,getKey,sTable:string):string;
procedure SetStr(const key:string; sTable,value:string);
procedure SetTable(sTable:string; value:TStrings);
procedure SetDataByWhere(whereKey,whereValue,setKey,setValue,sTable:string);
procedure DelTable(sTable:string);
procedure DelKey(const key:string; sTable:string);
public
constructor Create;
destructor Destroy; override;
procedure Reset(const iniFilename:string);
private
function GetValueFromRecord(const s:string):string;
function GetKeyFromRecord(const s:string):string;
function ClearNoteAndSpace(const s:string):string;
public
function EncodeStr(const s:string):string;
function DecodeStr(const s:string):string;
end;
var
Config: TConfig;
implementation
{ TConfig }
// IsValidFileName 是否合法的文件名
function IsValidFileName(const fileName: string): boolean;
var cnt: integer;
begin
result := fileName <> '';
if result then
for cnt := 1 to Length(fileName) do begin
result := NOT CharInSet(fileName[cnt], ['\', '/', ':', '*', '?', '"', '<', '>', '|']) ;
if NOT result then break;
end;
end;
// ClearNoteAndSpace 清除注释,但不清除空格
function TConfig.ClearNoteAndSpace(const s: string): string;
var i: integer;
begin
i := pos(';',s);
if i>0 then
result := copy(s,1,i-1)
else result := s;
result := StringReplace(result, ' ', '', [rfReplaceAll]);
result := StringReplace(result, #9, '', [rfReplaceAll]);
end;
// Create 创建对象
constructor TConfig.Create;
begin
fFile := TStringList.Create();
if FileExists( 'Config.ini' ) then begin
fIniFile:='Config.ini';
fFile.LoadFromFile( fIniFile );
end else if FileExists( 'Option.ini' ) then begin
fIniFile:='Option.ini';
fFile.LoadFromFile( fIniFile );
end else if FileExists( ChangeFileExt(ExtractFileName(Application.ExeName),'.ini') ) then begin
fIniFile:=ChangeFileExt(ExtractFileName(Application.ExeName),'.ini');
fFile.LoadFromFile( fIniFile );
end else
fIniFile:='Config.ini';
end;
// Reset 重新装载INI文件
procedure TConfig.Reset(const iniFilename: string);
begin
fIniFile := iniFilename;
if FileExists( fIniFile ) then
fFile.LoadFromFile( fIniFile )
else
fFile.Clear;
end;
// DecodeStr 解码字符串
function TConfig.DecodeStr(const s: string): string;
begin
result := StringReplace(s, '#6', ';', [rfReplaceAll]);
result := StringReplace(result, '#5', '=', [rfReplaceAll]);
result := StringReplace(result, '#4', ' ', [rfReplaceAll]);
result := StringReplace(result, '#3', ',', [rfReplaceAll]);
result := StringReplace(result, '#2', ':', [rfReplaceAll]);
result := StringReplace(result, '#1', #13#10, [rfReplaceAll]);
result := StringReplace(result, '#0', '#', [rfReplaceAll]);
end;
// EncodeStr 编码字符串
function TConfig.EncodeStr(const s: string): string;
begin
result := StringReplace(s, '#', '#0', [rfReplaceAll]);
result := StringReplace(result, #13#10, '#1', [rfReplaceAll]);
result := StringReplace(result, ':', '#2', [rfReplaceAll]);
result := StringReplace(result, ',', '#3', [rfReplaceAll]);
result := StringReplace(result, ' ', '#4', [rfReplaceAll]);
result := StringReplace(result, '=', '#5', [rfReplaceAll]);
result := StringReplace(result, ';', '#6', [rfReplaceAll]);
end;
// Destroy 销毁对象
destructor TConfig.Destroy;
begin
fFile.Free;
inherited;
end;
// GetValueFromRecord 从一行记录中得到值,未解码
function TConfig.GetValueFromRecord(const s: string): string;
var p:integer;
begin
p := pos('=',s);
if p>0 then
result := copy(s,p+1,MaxInt)
else result := '';
end;
// GetKeyFromRecord 从一行记录中得名称
function TConfig.GetKeyFromRecord(const s: string): string;
var p:integer;
begin
p := pos('=',s);
if p>0 then
result := copy(s,1,p-1)
else
result := s;
end;
// GetStr 取得一个字符串,已解码
function TConfig.GetStr(const key: string; sTable: string): string;
var i,r: integer;
s: string;
inTable: boolean;
begin
result := '';
sTable := '['+sTable+']';
r := fFile.Count-1;
inTable := false;
i := 0;
while i<=r do begin
s := self.ClearNoteAndSpace(fFile[i]);
inc(i);
if CompareText( s,sTable )=0 then inTable := true
else if s='' then continue
else if (s[1]='[') and (s[length(s)]=']') then inTable := false
else if inTable and (CompareText( self.GetKeyFromRecord(s),key )=0) then begin
result := self.DecodeStr( self.GetValueFromRecord(s) );
break;
end;
end;
end;
// GetTable 取得一个数据表,表中的数据尚未解码
function TConfig.GetTable(sTable: string): TStringList;
var i,r: integer;
s: string;
inTable: boolean;
begin
result := TStringList.Create;
sTable := '['+sTable+']';
r := fFile.Count-1;
inTable := false;
i := 0;
while i<=r do begin
s := self.ClearNoteAndSpace(fFile[i]);
inc(i);
if CompareText( s,sTable )=0 then inTable := true
else if s='' then continue
else if (s[1]='[') and (s[length(s)]=']') then inTable := false
else if inTable then begin
s := 'id:' + StringReplace(s,'=', ',', []);
result.Add(s);
end;
end;
end;
// GetDataSet 将指定的数据表以Dataset的方式返回,字段由第一行确定,只有ftInteger和ftMemo两种字段
function TConfig.GetDataSet(sTable: string): TClientDataSet;
var i,r: integer;
s: string;
inTable,isFieldCreated: boolean;
function isInt(const s: string):boolean;
var Value, Code: Integer;
begin
Val(s, Value, Code);
Result := Code=0;
end;
procedure CreateFields(r: TClientDataSet; s:string);
var p1,p2:integer;
sData:string;
begin
while True do begin
p1 := pos(':',s);
if p1>0 then begin
p2 := pos(',',s);
if p2>0 then dec(p2) else p2:=length(s);
sData:=copy(s,p1+1,p2-p1);
if isInt(sData) then
r.FieldDefs.Add( copy(s,1,p1-1),ftInteger)
else
r.FieldDefs.Add( copy(s,1,p1-1),ftMemo);
delete(s,1,p2+1);
if s='' then break;
end;
end;
end;
function GetValue(s,key: string; t: TFieldType):Variant;
var p:integer;
begin
s := ','+s+',';
key := ','+key+':';
p := pos(key,s);
result := '';
if p>0 then begin
delete(s,1,p+length(key)-1);
p := pos(',',s);
if p>0 then dec(p) else p:=length(s);
result := copy(s,1,p);
end;
if t=ftInteger then
try
result := strToInt(result);
except
result := 0;
end;
end;
procedure AddRecord(r: TClientDataSet; const s: string);
var i:integer;
begin
r.Append;
for i := 0 to r.FieldDefs.Count - 1 do
r.FieldByName(r.FieldDefs[i].Name).Value := GetValue(s, r.FieldDefs[i].Name, r.FieldDefs[i].DataType);
end;
begin
result := TClientDataSet.Create(nil);
sTable := '['+sTable+']';
r := fFile.Count-1;
inTable := false;
isFieldCreated := false;
i := 0;
while i<=r do begin
s := self.ClearNoteAndSpace(fFile[i]);
inc(i);
if CompareText( s,sTable )=0 then inTable := true
else if s='' then continue
else if (s[1]='[') and (s[length(s)]=']') then inTable := false
else if inTable then begin
s := 'id:' + StringReplace(s,'=', ',', []);
//字段
if not isFieldCreated then begin
CreateFields(result, s);
isFieldCreated := true;
result.CreateDataSet;
end;
//添加记录
AddRecord(result, s);
end;
end;
end;
TConfig = class(TObject)
fFile: TStringList;
fIniFile: string;
function GetStr(const key: string; sTable:string):string;
function GetTable(sTable:string):TStringList;
function GetDataSet(sTable:string):TClientDataSet;
function GetDataByWhere(whereKey,whereValue,getKey,sTable:string):string;
procedure SetStr(const key:string; sTable,value:string);
procedure SetTable(sTable:string; value:TStrings);
procedure SetDataByWhere(whereKey,whereValue,setKey,setValue,sTable:string);
procedure DelTable(sTable:string);
procedure DelKey(const key:string; sTable:string);
// GetDataByWhere 查找第一条满足条件数据,数据已解码,只支持基本的相等查询,更高级的请用TClientDataSet
function TConfig.GetDataByWhere(whereKey, whereValue, getKey, sTable: string): string;
var i,r,p: integer;
s: string;
inTable: boolean;
begin
result := '';
sTable := '['+sTable+']';
whereKey := ',' + whereKey + ':' + self.EncodeStr(whereValue) + ',';
getKey := ','+getKey+':';
r := fFile.Count-1;
inTable := false;
i := 0;
while i<=r do begin
s := self.ClearNoteAndSpace(fFile[i]);
inc(i);
if CompareText( s,sTable )=0 then inTable := true
else if s='' then continue
else if (s[1]='[') and (s[length(s)]=']') then inTable := false
else if inTable then begin
s := ',id:' + StringReplace(s,'=', ',', []) + ',';
p := pos(whereKey,s);
if p>0 then begin
p := pos(getKey,s);
if p>0 then begin
s := copy(s,p+length(getKey),MaxInt);
result := copy(s,1,pos(',',s)-1);
end;
break;
end;
end;
end;
end;
// DelKey 删除记录
procedure TConfig.DelKey(const key: string; sTable: string);
var i,r: integer;
s: string;
inTable: boolean;
begin
inTable := false;
sTable := '['+sTable+']';
r := fFile.Count-1;
i := 0;
while i<=r do begin
s := self.ClearNoteAndSpace(fFile[i]);
inc(i);
if s='' then continue
else if CompareText( s,sTable )=0 then inTable := true
else if (s[1]='[') and (s[length(s)]=']') then inTable := false
else if CompareText( self.GetKeyFromRecord(s),key )=0 then begin
dec(i);
fFile.Delete(i);
dec(r);
end;
end;
fFile.SaveToFile( self.fIniFile );
end;
// DelTable 删除表格
procedure TConfig.DelTable(sTable: string);
var i,r: integer;
s: string;
inTable: boolean;
begin
inTable := false;
sTable := '['+sTable+']';
r := fFile.Count-1;
i := 0;
while i<=r do begin
s := self.ClearNoteAndSpace(fFile[i]);
if CompareText( s,sTable )=0 then inTable := true
else if (s<>'') and (s[1]='[') and (s[length(s)]=']') then inTable := false;
if inTable then begin
fFile.Delete(i);
dec(r);
end else inc(i);
end;
fFile.SaveToFile( self.fIniFile );
end;
// SetStr 更新满足条件的所有行,保持行末原来的注释
procedure TConfig.SetStr(const key:string; sTable, value: string);
var i,r,lastTableLine: integer;
s: string;
inTable,isUpdated,haveTable: boolean;
begin
sTable := '['+sTable+']';
value := key + '=' + self.EncodeStr(value);
inTable := false;
isUpdated := false;
haveTable := false;
lastTableLine := 0;
r := fFile.Count-1;
i := 0;
while i<=r do begin
s := self.ClearNoteAndSpace(fFile[i]);
if CompareText( s,sTable )=0 then begin
inTable := true;
haveTable := true;
end
else if s='' then continue
else if (s[1]='[') and (s[length(s)]=']') then begin
if (lastTableLine=0) and inTable then lastTableLine:=i;
inTable := false;
end
else if inTable and (CompareText( self.GetKeyFromRecord(s),key )=0) then begin
if pos(';',fFile[i])>0 then
fFile[i] := value + ' ' + copy(fFile[i],pos(';',fFile[i]),MaxInt)
else
fFile[i] := value;
isUpdated := true;
end;
inc(i);
end;
if not isUpdated then
if not haveTable then begin
fFile.Add(sTable);
fFile.Add(value);
end else begin
if lastTableLine>0 then
fFile.Insert(lastTableLine,value)
else
fFile.Add(value);
end;
fFile.SaveToFile( self.fIniFile );
end;
// SetTable 更新一个表格,删除表格中原来的所有数据,添加value为表格,value的每行都必须是key=value格式的,并且已经编码过的
procedure TConfig.SetTable(sTable: string; value: TStrings);
var i,j,r: integer;
s: string;
inTable,isUpdated,haveTable: boolean;
begin
sTable := '['+sTable+']';
inTable := false;
isUpdated := false;
haveTable := false;
r := fFile.Count-1;
i := 0;
while i<=r do begin
s := self.ClearNoteAndSpace(fFile[i]);
if CompareText( s,sTable )=0 then begin
if isUpdated then begin
fFile.Delete(i);
dec(r);
dec(i);
end;
inTable := true;
haveTable := true;
end
else if s='' then begin
if inTable then begin
fFile.Delete(i);
dec(r);
dec(i);
end;
end
else if (s[1]='[') and (s[length(s)]=']') then begin
if inTable then begin
if not isUpdated then begin
for j := value.Count - 1 downto 0 do
fFile.Insert(i,value[j]);
isUpdated := true;
inc(i,value.Count);
inc(r,value.Count);
end;
inTable := false;
end;
end
else begin
if inTable then begin
fFile.Delete(i);
dec(r);
dec(i);
end;
end;
inc(i);
end;
if not isUpdated then begin
if not haveTable then fFile.Add(sTable);
for j := 0 to value.Count - 1 do
fFile.add(value[j]);
end;
fFile.SaveToFile( self.fIniFile );
end;
// SetDataByWhere 更新满足条件的所有数据,只支持相等查询,无满足条件行则跳过,更高级的请用SetTable
procedure TConfig.SetDataByWhere(whereKey, whereValue, setKey, setValue, sTable: string);
var i,r,p: integer;
s,s1: string;
inTable: boolean;
begin
sTable := '['+sTable+']';
whereKey := ',' + whereKey + ':' + self.EncodeStr(whereValue) + ',';
setKey := ','+setKey+':';
setValue := self.EncodeStr(setValue);
r := fFile.Count-1;
inTable := false;
i := 0;
while i<=r do begin
s := self.ClearNoteAndSpace(fFile[i]);
if CompareText( s,sTable )=0 then inTable := true
else if s='' then continue
else if (s[1]='[') and (s[length(s)]=']') then inTable := false
else if inTable then begin
s := ',id:' + StringReplace(s,'=', ',', []) + ',';
p := pos(whereKey,s);
if p>0 then begin
p := pos(setKey,s);
if p>0 then begin
inc(p,length(setKey));
s1 := copy(s,p,MaxInt);
s := copy(s,5,p-5);
p := pos(',',s1);
s := s + setValue + copy(s1,p,length(s1)-p);
p := pos(';',fFile[i]);
if p>0 then
s := stringReplace(s,',','=',[]) + copy(fFile[i],p,MaxInt)
else
s := stringReplace(s,',','=',[]);
fFile[i] := s;
end;
end;
end;
inc(i);
end;
fFile.SaveToFile( self.fIniFile );
end;
initialization
Config := TConfig.Create;
finalization
Config.Free;
end.