fpc/packages/ide/wini.pas

{
    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;

{$ifdef cpullvm}
{$modeswitch nestedprocvars}
{$endif}
{$H-}

interface

uses Objects;

type

    PINIEntry = ^TINIEntry;
    TINIEntry = object(TObject)
      constructor Init(const ALine: string);
      constructor Init(const ATag,AValue,AComment: string);
      function    GetText: string;
      function    GetTag: string;
      function    GetComment: string;
      function    GetValue: string;
      procedure   SetValue(const S: string);
      procedure   SetComment(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    AddEntry(const Tag,Value,Comment: string): PINIEntry;
      function    SearchEntry(Tag: string): PINIEntry; virtual;
      procedure   DeleteEntry(Tag: string);
      procedure   ForEachEntry(EnumProc: TCallbackProcParam); 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: TCallbackProcParam); virtual;
      procedure   ForEachEntry(const Section: string; EnumProc: TCallbackProcParam); virtual;
      function    GetEntry(const Section, Tag, Default: string): string; virtual;
      procedure   SetEntry(const Section, Tag, Value: string); virtual;
      procedure   SetEntry(const Section, Tag, Value,Comment: 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     : AnsiChar = ';';
      ValidStrDelimiters: set of AnsiChar = ['''','"'];

function EscapeIniText(S : string) : String;

implementation

uses
  WUtils;

function EscapeIniText(S : string) : String;
var
  delimiter : AnsiChar;
  i: integer;
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
    begin
      { we use " delimiter, but the text also contains double quotes,
        which need to be escaped, by doubling it }
      delimiter:='"';
      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));
    end;
  EscapeIniText:=delimiter+s+delimiter;
end;

{$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;

constructor TINIEntry.Init(const ATag,AValue,AComment: string);
begin
  inherited Init;
  Tag:=NewStr(ATag);
  Value:=NewStr(AValue);
  Comment:=NewStr(AComment);
  Text:=NewStr(GetText);
end;


function TINIEntry.GetText: string;
var S,CoS: string;
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
              S:=EscapeIniText(S);
            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.SetComment(const S: string);
begin
  if (GetComment<>S) then
  begin
    if Text<>nil then DisposeStr(Text); Text:=nil;
    if Comment<>nil then DisposeStr(Comment);
    Comment:=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: AnsiChar;
    InString: boolean;
    Delimiter: AnsiChar;
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
          else if (C=Delimiter) then
            begin
              { Delimiter inside escaped Value are simply doubled }
              if (P2+1<length(S)) and (S[P2+1]=Delimiter) then
                ValueS:=ValueS+Delimiter
              else
                InString:=not InString;
            end
          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;
  Tag : String;
begin
  if pos('=',S)>0 then
    begin
      Tag:=copy(S,1,pos('=',S)-1);
      E:=SearchEntry(Tag);
    end
  else
    E:=nil;
  if not assigned(E) then
    begin
      New(E, Init(S));
      Entries^.Insert(E);
    end
  else
    begin
      if assigned(E^.Text) then
         DisposeStr(E^.Text);
      E^.Text:=NewStr(S);
      E^.Split;
    end;
  AddEntry:=E;
end;

function TINISection.AddEntry(const Tag,Value,Comment: string): PINIEntry;
var E: PINIEntry;
begin
  E:=SearchEntry(Tag);
  if not assigned(E) then
    begin
      New(E, Init(Tag,Value,Comment));
      Entries^.Insert(E);
    end
  else
    begin
      E^.SetValue(Value);
      if Comment<>'' then
        E^.SetComment(Comment);
    end;
  AddEntry:=E;
end;

procedure TINIFile.ForEachSection(EnumProc: TCallbackProcParam);
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: TCallbackProcParam);
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;
    oFileMode : byte;
begin
  New(P, Init(MainSectionName));
  Sections^.Insert(P);
  oFileMode:=FileMode;   {save file open mode}
  FileMode:=0;           {Reset will open file in read only mode }
  Assign(f,FileName^);
{$I-}
  Reset(f);
  FileMode:=oFileMode;   {restore file open mode}
  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(TCallbackFunBoolParam(@EntryModified))<>nil);
  end;

begin
  IsModified:=(Sections^.FirstThat(TCallbackFunBoolParam(@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: TCallbackProcParam);
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,Comment: 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,Comment);
      E^.Modified:=true;
    end;
  if E<>nil then
    E^.SetValue(Value);
end;

procedure TINIFile.SetEntry(const Section, Tag, Value: string);
begin
  SetEntry(Section,Tag,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.