mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 05:28:15 +02:00
576 lines
13 KiB
ObjectPascal
576 lines
13 KiB
ObjectPascal
{
|
||
This file is part of the Free Pascal Integrated Development Environment
|
||
Copyright (c) 1998 by B‚rczi G bor
|
||
|
||
Reading and writing .INI files
|
||
|
||
See the file COPYING.FPC, included in this distribution,
|
||
for details about the copyright.
|
||
|
||
This program is distributed in the hope that it will be useful,
|
||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||
|
||
**********************************************************************}
|
||
unit WINI;
|
||
|
||
interface
|
||
|
||
uses Objects;
|
||
|
||
type
|
||
|
||
PINIEntry = ^TINIEntry;
|
||
TINIEntry = object(TObject)
|
||
constructor Init(const ALine: string);
|
||
function GetText: string;
|
||
function GetTag: string;
|
||
function GetComment: string;
|
||
function GetValue: string;
|
||
procedure SetValue(const S: string);
|
||
destructor Done; virtual;
|
||
private
|
||
TagHash : Cardinal;
|
||
Tag : PString;
|
||
Value : PString;
|
||
Comment : PString;
|
||
Text : PString;
|
||
Modified : boolean;
|
||
procedure Split;
|
||
end;
|
||
|
||
PINISection = ^TINISection;
|
||
TINISection = object(TObject)
|
||
constructor Init(const AName: string);
|
||
function GetName: string;
|
||
function AddEntry(const S: string): PINIEntry;
|
||
function SearchEntry(Tag: string): PINIEntry; virtual;
|
||
procedure DeleteEntry(Tag: string);
|
||
procedure ForEachEntry(EnumProc: pointer); virtual;
|
||
destructor Done; virtual;
|
||
private
|
||
NameHash : Cardinal;
|
||
Name : PString;
|
||
Entries : PCollection;
|
||
end;
|
||
|
||
PINIFile = ^TINIFile;
|
||
TINIFile = object(TObject)
|
||
MakeNullEntries: boolean;
|
||
constructor Init(const AFileName: string);
|
||
function GetFileName: string;
|
||
function Read: boolean; virtual;
|
||
function Update: boolean; virtual;
|
||
function IsModified: boolean; virtual;
|
||
function SearchSection(Section: string): PINISection; virtual;
|
||
function SearchEntry(const Section, Tag: string): PINIEntry; virtual;
|
||
procedure ForEachSection(EnumProc: pointer); virtual;
|
||
procedure ForEachEntry(const Section: string; EnumProc: pointer); virtual;
|
||
function GetEntry(const Section, Tag, Default: string): string; virtual;
|
||
procedure SetEntry(const Section, Tag, Value: string); virtual;
|
||
function GetIntEntry(const Section, Tag: string; Default: longint): longint; virtual;
|
||
procedure SetIntEntry(const Section, Tag: string; Value: longint); virtual;
|
||
procedure DeleteSection(const Section: string); virtual;
|
||
procedure DeleteEntry(const Section, Tag: string);
|
||
destructor Done; virtual;
|
||
private
|
||
{ ReadOnly: boolean;}
|
||
Sections: PCollection;
|
||
FileName: PString;
|
||
end;
|
||
|
||
const MainSectionName : string[40] = 'MainSection';
|
||
CommentChar : char = ';';
|
||
ValidStrDelimiters: set of char = ['''','"'];
|
||
|
||
implementation
|
||
|
||
uses
|
||
WUtils;
|
||
|
||
{$IFOPT Q+}
|
||
{$Q-}
|
||
{$DEFINE REENABLE_Q}
|
||
{$ENDIF}
|
||
{$IFOPT R+}
|
||
{$R-}
|
||
{$DEFINE REENABLE_R}
|
||
{$ENDIF}
|
||
|
||
function CalcHash(const s: String): Cardinal;
|
||
var
|
||
i: integer;
|
||
begin
|
||
CalcHash := 0;
|
||
for i := 1 to Length(s) do
|
||
CalcHash := CalcHash shl 9 - CalcHash shl 4 + Ord(S[I]);
|
||
end;
|
||
|
||
{$IFDEF REENABLE_Q}
|
||
{$Q+}
|
||
{$ENDIF}
|
||
{$IFDEF REENABLE_R}
|
||
{$R+}
|
||
{$ENDIF}
|
||
|
||
constructor TINIEntry.Init(const ALine: string);
|
||
begin
|
||
inherited Init;
|
||
Text:=NewStr(ALine);
|
||
Split;
|
||
end;
|
||
|
||
|
||
function TINIEntry.GetText: string;
|
||
var S,CoS: string;
|
||
delimiter : char;
|
||
i : longint;
|
||
begin
|
||
if Text=nil then
|
||
begin
|
||
CoS:=GetComment;
|
||
S:=GetTag+'='+GetValue;
|
||
if Trim(S)='=' then S:=CoS else
|
||
if CoS<>'' then
|
||
begin
|
||
{ if Value contains CommentChar, we need to add delimiters }
|
||
if pos(CommentChar,S)>0 then
|
||
begin
|
||
delimiter:=#0;
|
||
while delimiter < #255 do
|
||
begin
|
||
if (delimiter in ValidStrDelimiters) and
|
||
(pos(delimiter,S)=0) then
|
||
break;
|
||
delimiter:=succ(delimiter);
|
||
end;
|
||
if delimiter=#255 then
|
||
delimiter:='"';
|
||
{ we use \", but we also need to escape \ itself }
|
||
for i:=length(s) downto 1 do
|
||
if (s[i]=delimiter) then
|
||
s:=copy(s,1,i-1)+'\'+delimiter+copy(s,i+1,length(s))
|
||
else if (s[i]='\') then
|
||
s:=copy(s,1,i-1)+'\\'+copy(s,i+1,length(s));
|
||
|
||
s:=delimiter+s+delimiter;
|
||
end;
|
||
S:=S+' '+CommentChar+' '+CoS;
|
||
end
|
||
end
|
||
else S:=Text^;
|
||
GetText:=S;
|
||
end;
|
||
|
||
|
||
function TINIEntry.GetTag: string;
|
||
begin
|
||
GetTag:=GetStr(Tag);
|
||
end;
|
||
|
||
|
||
function TINIEntry.GetComment: string;
|
||
begin
|
||
GetComment:=GetStr(Comment);
|
||
end;
|
||
|
||
|
||
function TINIEntry.GetValue: string;
|
||
begin
|
||
GetValue:=GetStr(Value);
|
||
end;
|
||
|
||
|
||
procedure TINIEntry.SetValue(const S: string);
|
||
begin
|
||
if GetValue<>S then
|
||
begin
|
||
if Text<>nil then DisposeStr(Text); Text:=nil;
|
||
if Value<>nil then DisposeStr(Value);
|
||
Value:=NewStr(S);
|
||
Modified:=true;
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure TINIEntry.Split;
|
||
var S,ValueS: string;
|
||
P,P2,StartP: longint;
|
||
{ using byte for P2 lead to infinite loops PM }
|
||
C: char;
|
||
InString: boolean;
|
||
Delimiter: char;
|
||
begin
|
||
S:=GetText; Delimiter:=#0;
|
||
P:=Pos('=',S); P2:=Pos(CommentChar,S);
|
||
if (P2<>0) and (P2<P) then
|
||
P:=0;
|
||
if P<>0 then
|
||
begin
|
||
Tag:=NewStr(copy(S,1,P-1));
|
||
TagHash:=CalcHash(UpcaseStr(Tag^));
|
||
P2:=P+1; InString:=false; ValueS:='';
|
||
StartP:=P2;
|
||
while (P2<=length(S)) do
|
||
begin
|
||
C:=S[P2];
|
||
if (P2=StartP) and (C in ValidStrDelimiters) then
|
||
begin
|
||
Delimiter:=C;
|
||
InString:=true;
|
||
end
|
||
{ if Value is delimited with ' or ", handle escaping }
|
||
else if (Delimiter<>#0) and (C='\') and (P2<length(S)) then
|
||
begin
|
||
inc(P2);
|
||
C:=S[P2];
|
||
ValueS:=ValueS+C;
|
||
end
|
||
else if C=Delimiter then
|
||
InString:=not InString
|
||
else if (C=CommentChar) and (InString=false) then
|
||
Break
|
||
else
|
||
ValueS:=ValueS+C;
|
||
Inc(P2);
|
||
end;
|
||
Value:=NewStr(Trim(ValueS));
|
||
Comment:=NewStr(copy(S,P2+1,High(S)));
|
||
{ dispose raw text as special treatment is needed for
|
||
write }
|
||
if assigned(Comment) and assigned(Text) and
|
||
(delimiter<>#0) then
|
||
begin
|
||
DisposeStr(Text);
|
||
Text:=nil;
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
Tag:=nil;
|
||
TagHash:=0;
|
||
Value:=nil;
|
||
Comment:=NewStr(S);
|
||
end;
|
||
end;
|
||
|
||
|
||
destructor TINIEntry.Done;
|
||
begin
|
||
inherited Done;
|
||
if Text<>nil then DisposeStr(Text);
|
||
if Tag<>nil then DisposeStr(Tag);
|
||
if Value<>nil then DisposeStr(Value);
|
||
if Comment<>nil then DisposeStr(Comment);
|
||
end;
|
||
|
||
|
||
constructor TINISection.Init(const AName: string);
|
||
begin
|
||
inherited Init;
|
||
Name:=NewStr(AName);
|
||
NameHash:=CalcHash(UpcaseStr(AName));
|
||
New(Entries, Init(50,500));
|
||
end;
|
||
|
||
|
||
function TINISection.GetName: string;
|
||
begin
|
||
GetName:=GetStr(Name);
|
||
end;
|
||
|
||
function TINISection.AddEntry(const S: string): PINIEntry;
|
||
var E: PINIEntry;
|
||
begin
|
||
New(E, Init(S));
|
||
Entries^.Insert(E);
|
||
AddEntry:=E;
|
||
end;
|
||
|
||
procedure TINIFile.ForEachSection(EnumProc: pointer);
|
||
var I: Sw_integer;
|
||
S: PINISection;
|
||
begin
|
||
for I:=0 to Sections^.Count-1 do
|
||
begin
|
||
S:=Sections^.At(I);
|
||
CallPointerLocal(EnumProc,get_caller_frame(get_frame,get_pc_addr),S);
|
||
end;
|
||
end;
|
||
|
||
procedure TINISection.ForEachEntry(EnumProc: pointer);
|
||
var I: integer;
|
||
E: PINIEntry;
|
||
begin
|
||
for I:=0 to Entries^.Count-1 do
|
||
begin
|
||
E:=Entries^.At(I);
|
||
CallPointerLocal(EnumProc,get_caller_frame(get_frame,get_pc_addr),E);
|
||
end;
|
||
end;
|
||
|
||
function TINISection.SearchEntry(Tag: string): PINIEntry;
|
||
var
|
||
P : PINIEntry;
|
||
I : Sw_integer;
|
||
Hash : Cardinal;
|
||
begin
|
||
SearchEntry:=nil;
|
||
Tag:=UpcaseStr(Tag);
|
||
Hash:=CalcHash(Tag);
|
||
for I:=0 to Entries^.Count-1 do
|
||
begin
|
||
P:=Entries^.At(I);
|
||
if (P^.TagHash=Hash) and (UpcaseStr(P^.GetTag)=Tag) then
|
||
begin
|
||
SearchEntry:=P;
|
||
break;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TINISection.DeleteEntry(Tag: string);
|
||
var
|
||
P : PIniEntry;
|
||
begin
|
||
P:=SearchEntry(Tag);
|
||
if assigned(P) then
|
||
Entries^.Free(P);
|
||
end;
|
||
|
||
destructor TINISection.Done;
|
||
begin
|
||
inherited Done;
|
||
if Name<>nil then DisposeStr(Name);
|
||
Dispose(Entries, Done);
|
||
end;
|
||
|
||
|
||
constructor TINIFile.Init(const AFileName: string);
|
||
begin
|
||
inherited Init;
|
||
FileName:=NewStr(AFileName);
|
||
New(Sections, Init(50,50));
|
||
Read;
|
||
end;
|
||
|
||
function TINIFile.GetFileName: string;
|
||
begin
|
||
GetFileName:=GetStr(FileName);
|
||
end;
|
||
|
||
function TINIFile.Read: boolean;
|
||
var f: text;
|
||
OK: boolean;
|
||
S,TS: string;
|
||
P: PINISection;
|
||
I: integer;
|
||
begin
|
||
New(P, Init(MainSectionName));
|
||
Sections^.Insert(P);
|
||
Assign(f,FileName^);
|
||
{$I-}
|
||
Reset(f);
|
||
OK:=EatIO=0;
|
||
while OK and (Eof(f)=false) do
|
||
begin
|
||
readln(f,S);
|
||
TS:=Trim(S);
|
||
OK:=EatIO=0;
|
||
if OK then
|
||
if TS<>'' then
|
||
if copy(TS,1,1)='[' then
|
||
begin
|
||
I:=Pos(']',TS); if I=0 then I:=length(TS)+1;
|
||
New(P, Init(copy(TS,2,I-2)));
|
||
Sections^.Insert(P);
|
||
end else
|
||
begin
|
||
P^.AddEntry(S);
|
||
end;
|
||
end;
|
||
Close(f);
|
||
EatIO;
|
||
{$I+}
|
||
Read:=true;
|
||
end;
|
||
|
||
function TINIFile.IsModified: boolean;
|
||
|
||
function SectionModified(P: PINISection): boolean;
|
||
|
||
function EntryModified(E: PINIEntry): boolean;
|
||
begin
|
||
EntryModified:=E^.Modified;
|
||
end;
|
||
|
||
begin
|
||
SectionModified:=(P^.Entries^.FirstThat(@EntryModified)<>nil);
|
||
end;
|
||
|
||
begin
|
||
IsModified:=(Sections^.FirstThat(@SectionModified)<>nil);
|
||
end;
|
||
|
||
|
||
function TINIFile.Update: boolean;
|
||
var f: text;
|
||
OK: boolean;
|
||
P: PINISection;
|
||
E: PINIEntry;
|
||
I,J: integer;
|
||
begin
|
||
Assign(f,FileName^);
|
||
{$I-}
|
||
Rewrite(f);
|
||
OK:=EatIO=0;
|
||
if OK then
|
||
for I:=0 to Sections^.Count-1 do
|
||
begin
|
||
P:=Sections^.At(I);
|
||
if I<>0 then writeln(f,'['+P^.GetName+']');
|
||
for J:=0 to P^.Entries^.Count-1 do
|
||
begin
|
||
E:=P^.Entries^.At(J);
|
||
writeln(f,E^.GetText);
|
||
OK:=EatIO=0;
|
||
if OK=false then Break;
|
||
end;
|
||
if OK and ((I>0) or (P^.Entries^.Count>0)) and (I<Sections^.Count-1) then
|
||
writeln(f,'');
|
||
OK:=OK and (EatIO=0);
|
||
if OK=false then Break;
|
||
end;
|
||
Close(f);
|
||
EatIO;
|
||
{$I+}
|
||
if OK then
|
||
for I:=0 to Sections^.Count-1 do
|
||
begin
|
||
P:=Sections^.At(I);
|
||
for J:=0 to P^.Entries^.Count-1 do
|
||
begin
|
||
E:=P^.Entries^.At(J);
|
||
E^.Modified:=false;
|
||
end;
|
||
end;
|
||
Update:=OK;
|
||
end;
|
||
|
||
function TINIFile.SearchSection(Section: string): PINISection;
|
||
var
|
||
P : PINISection;
|
||
I : Sw_integer;
|
||
Hash : Cardinal;
|
||
begin
|
||
SearchSection:=nil;
|
||
Section:=UpcaseStr(Section);
|
||
Hash:=CalcHash(Section);
|
||
for I:=0 to Sections^.Count-1 do
|
||
begin
|
||
P:=Sections^.At(I);
|
||
if (P^.NameHash=Hash) and (UpcaseStr(P^.GetName)=Section) then
|
||
begin
|
||
SearchSection:=P;
|
||
break;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TINIFile.SearchEntry(const Section, Tag: string): PINIEntry;
|
||
var P: PINISection;
|
||
E: PINIEntry;
|
||
begin
|
||
P:=SearchSection(Section);
|
||
if P=nil then E:=nil else
|
||
E:=P^.SearchEntry(Tag);
|
||
SearchEntry:=E;
|
||
end;
|
||
|
||
procedure TINIFile.ForEachEntry(const Section: string; EnumProc: pointer);
|
||
var P: PINISection;
|
||
E: PINIEntry;
|
||
I: integer;
|
||
begin
|
||
P:=SearchSection(Section);
|
||
if P<>nil then
|
||
for I:=0 to P^.Entries^.Count-1 do
|
||
begin
|
||
E:=P^.Entries^.At(I);
|
||
CallPointerMethodLocal(EnumProc,get_frame,@Self,E);
|
||
end;
|
||
end;
|
||
|
||
function TINIFile.GetEntry(const Section, Tag, Default: string): string;
|
||
var E: PINIEntry;
|
||
S: string;
|
||
begin
|
||
E:=SearchEntry(Section,Tag);
|
||
if E=nil then S:=Default else
|
||
S:=E^.GetValue;
|
||
GetEntry:=S;
|
||
end;
|
||
|
||
procedure TINIFile.SetEntry(const Section, Tag, Value: string);
|
||
var E: PINIEntry;
|
||
P: PINISection;
|
||
begin
|
||
E:=SearchEntry(Section,Tag);
|
||
if E=nil then
|
||
if (MakeNullEntries=true) or (Value<>'') then
|
||
begin
|
||
P:=SearchSection(Section);
|
||
if P=nil then
|
||
begin
|
||
New(P, Init(Section));
|
||
Sections^.Insert(P);
|
||
end;
|
||
E:=P^.AddEntry(Tag+'='+Value);
|
||
E^.Modified:=true;
|
||
end;
|
||
if E<>nil then
|
||
E^.SetValue(Value);
|
||
end;
|
||
|
||
function TINIFile.GetIntEntry(const Section, Tag: string; Default: longint): longint;
|
||
var L: longint;
|
||
begin
|
||
L:=StrToInt(GetEntry(Section,Tag,IntToStr(Default)));
|
||
if LastStrToIntResult<>0 then L:=Default;
|
||
GetIntEntry:=L;
|
||
end;
|
||
|
||
procedure TINIFile.SetIntEntry(const Section, Tag: string; Value: longint);
|
||
begin
|
||
SetEntry(Section,Tag,IntToStr(Value));
|
||
end;
|
||
|
||
procedure TINIFile.DeleteSection(const Section: string);
|
||
var P: PINISection;
|
||
begin
|
||
P:=SearchSection(Section);
|
||
if P<>nil then
|
||
Sections^.Free(P);
|
||
end;
|
||
|
||
procedure TINIFile.DeleteEntry(const Section, Tag: string);
|
||
var P: PINISection;
|
||
begin
|
||
P:=SearchSection(Section);
|
||
if P<>nil then
|
||
P^.DeleteEntry(Tag);
|
||
end;
|
||
|
||
destructor TINIFile.Done;
|
||
begin
|
||
if IsModified then
|
||
Update;
|
||
inherited Done;
|
||
if FileName<>nil then
|
||
DisposeStr(FileName);
|
||
Dispose(Sections, Done);
|
||
end;
|
||
|
||
|
||
END.
|