freepascal.compiler/packages/fcl-base/src/inicol.pp

{
    This file is part of the Free Component Library (FCL)
    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl

    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.

 **********************************************************************}

{$mode objfpc}
{$h+}
unit inicol;

interface

Uses SysUtils,Classes,Inifiles;

Type

  { TIniCollectionItem }

  TIniCollectionItem = Class(TCollectionItem)
  protected
    function GetSectionName: String; virtual; abstract;
    procedure SetSectionName(const Value: String); virtual; abstract;
  Public
    Procedure SaveToIni(Ini: TCustomInifile; Section : String); Virtual; Abstract;
    Procedure LoadFromIni(Ini: TCustomInifile; Section : String); Virtual; Abstract;
    Procedure SaveToFile(FileName : String; Section : String);
    Procedure LoadFromFile(FileName : String; Section : String);
    Property SectionName : String Read GetSectionName Write SetSectionName;
  end;

  TIniCollection = Class(TCollection)
  private
    FFileName: String;
    FGlobalSection: String;
  protected
    FPrefix: String;  // Descendent must set this.
    FSectionPrefix : String;  // Descendent must set this too.
  Public
    Procedure Load;
    Procedure Save;
    Procedure SaveToIni(Ini: TCustomInifile; Section : String); virtual;
    Procedure SaveToFile(AFileName : String; Section : String);
    Procedure LoadFromIni(Ini: TCustomInifile; Section : String); virtual;
    Procedure LoadFromFile(AFileName : String; Section : String);
    Property Prefix : String Read FPrefix;
    Property SectionPrefix : String Read FSectionPrefix;
    Property FileName : String Read FFileName Write FFileName;
    Property GlobalSection : String Read FGlobalSection Write FGlobalSection;
  end;

  { TNamedIniCollectionItem }

  TNamedIniCollectionItem = Class(TIniCollectionItem)
  private
    procedure SetName(const AValue: String);
  Protected
    FName : String;
    FUserData : TObject;
  Protected
    Procedure SetCollection(Value : TCollection); override;
    function GetSectionName: String; override;
    procedure SetSectionName(const Value: String); override;
  Public
    Property UserData : TObject Read FUserData Write FUserData;
  Published
    Property Name : String Read FName Write SetName;
  end;

  { TNamedIniCollection }
  TNamedIniCollection = Class(TIniCollection)
  private
    function GetNamedItem(Index: Integer): TNamedIniCollectionItem;
    procedure SetNamedItem(Index: Integer; const AValue: TNamedIniCollectionItem);
  Public
    Function IndexOfUserData(UserData : TObject) : Integer;
    Function IndexOfName(Const AName : String) : Integer;
    Function FindByName(Const AName : string) : TNamedIniCollectionItem;
    Function FindByUserData(UserData : TObject) : TNamedIniCollectionItem;
    Property NamedItems [Index: Integer] : TNamedIniCollectionItem Read GetNamedItem Write SetNamedItem; default;
  end;

  EIniCol = Class(Exception);

Const
  KeyCount = 'Count';
  SGlobal  = 'Global';

implementation

{ TIniCollectionItem }

resourcestring
  SErrNoFileName = '%s: No filename specified.';
  SErrNoSection = '%s: No [global] section specified.';
  SErrDuplicateName = 'Duplicate names "%s" not allowed in collection';
  
procedure TIniCollectionItem.LoadFromFile(FileName, Section: String);

Var
  Ini : TMemInifile;

begin
  Ini:=TMemInifile.Create(FileName);
  Try
    LoadFromIni(Ini,Section);
  Finally
    Ini.Free;
  end;
end;

procedure TIniCollectionItem.SaveToFile(FileName, Section: String);

Var
  Ini : TMemInifile;

begin
  Ini:=TMemInifile.Create(FileName);
  Try
    SaveToIni(Ini,Section);
    Ini.UpdateFile;
  Finally
    Ini.Free;
  end;
end;


{ TIniCollection }

procedure TIniCollection.Load;
begin
  If (FFileName='') then
    Raise EIniCol.CreateFmt(SErrNoFileName,[ClassName]);
  If (GlobalSection='') then
    Raise EIniCol.CreateFmt(SErrNoSection,[ClassName]);
  LoadFromFile(FFileName,GlobalSection)
end;

procedure TIniCollection.LoadFromFile(AFileName, Section: String);

Var
  Ini  : TMemIniFile;

begin
  Ini:=TMemInifile.Create(AFileName);
  Try
    LoadFromIni(Ini,Section);
    FFileName:=AFileName;
    FGlobalSection:=Section;
  Finally
    ini.Free;
  end;
end;

procedure TIniCollection.LoadFromIni(Ini: TCustomInifile; Section: String);

Var
  ACount,I : Integer;
  N,SP : String;

begin
  Clear;
  SP:=FSectionPrefix;
  If (SP<>'') then
    SP:=SP+'_';
  ACount:=Ini.ReadInteger(Section,KeyCount,0);
  For I:=1 to ACount do
    begin
    N:=Ini.ReadString(Section,Prefix+IntToStr(I),'');
    If (N<>'') then
      With Add as TIniCollectionItem do
        begin
        SectionName:=N;
        LoadFromIni(Ini,SP+N);
        end;
    end;
end;

procedure TIniCollection.Save;
begin
  If (FFileName='') then
    Raise EIniCol.CreateFmt(SErrNoFileName,[ClassName]);
  If (GlobalSection='') then
    Raise EIniCol.CreateFmt(SErrNoSection,[ClassName]);
  SaveToFile(FFileName,GlobalSection)
end;

procedure TIniCollection.SaveToFile(AFileName, Section: String);

Var
  Ini : TMemIniFile;

begin
  Ini:=TMemInifile.Create(AFileName);
  Try
    Ini.CacheUpdates:=True;
    SaveToIni(Ini,Section);
    Ini.UpdateFile;
  finally
    Ini.Free;
  end;
end;

procedure TIniCollection.SaveToIni(Ini: TCustomInifile; Section: String);

Var
  S,V,SP : String;
  I   : Integer;
  CI  : TIniCollectionItem;

begin
  SP:=FSectionPrefix;
  if (SP<>'') then
    SP:=SP+'_';
  Ini.WriteInteger(Section,KeyCount,Count);
  For I:=0 to Count-1 do
    begin
    CI:=(Items[i]) as TIniCollectionItem;
    With CI do
      begin
      V:=SectionName;
      S:=Prefix+IntToStr(I+1);
      Ini.WriteString(Section,S,V);
      CI.SaveToIni(Ini,SP+V);
      end;
    end;
end;

{ ---------------------------------------------------------------------
  TNamedIniCollectionItem
  ---------------------------------------------------------------------}

procedure TNamedIniCollectionItem.SetName(const AValue: String);
begin
  If (CompareText(AValue,FName)<>0) then
    begin
    If (AValue<>'') and (Collection<>Nil) and (Collection is TNamedIniCollection) then
      If TNamedIniCollection(Collection).IndexOfName(AValue)<>-1 then
        Raise EIniCol.CreateFmt(SErrDuplicateName,[AValue]);
    end;
  FName:=AValue;
end;

procedure TNamedIniCollectionItem.SetCollection(Value: TCollection);
begin
  If (Value<>Collection) then
    begin
    If (Value<>Nil) and (Value is TNamedIniCollection) Then
      If TNamedIniCollection(Value).IndexOfName(Self.Name)<>-1 then
        Raise EIniCol.CreateFmt(SErrDuplicateName,[Self.Name]);
    end;
  inherited SetCollection(Value);
end;

function TNamedIniCollectionItem.GetSectionName: String;
begin
  Result:=FName;
end;

procedure TNamedIniCollectionItem.SetSectionName(const Value: String);
begin
  FName:=Value; // Skip check. Ini files have only 1 named section
end;

{ ---------------------------------------------------------------------
  TNamedIniCollection
  ---------------------------------------------------------------------}

function TNamedIniCollection.GetNamedItem(Index: Integer): TNamedIniCollectionItem;
begin
  Result:=Items[Index] as TNamedIniCollectionItem;
end;

procedure TNamedIniCollection.SetNamedItem(Index: Integer; const AValue: TNamedIniCollectionItem);
begin
  Items[Index]:=AValue;
end;

function TNamedIniCollection.IndexOfUserData(UserData: TObject): Integer;
begin
  If (UserData=Nil) then
    Result:=-1
  else
    begin
    Result:=Count-1;
    While (Result>=0) and (GetNamedItem(Result).UserData<>UserData) do
      Dec(Result);
    end;
end;

function TNamedIniCollection.IndexOfName(const AName: String): Integer;
begin
  Result:=Count-1;
  While (Result>=0) and (CompareText(GetNamedItem(Result).Name,AName)<>0) do
    Dec(Result);
end;

function TNamedIniCollection.FindByName(const AName : string): TNamedIniCollectionItem;

Var
  I : Integer;

begin
  I:=IndexOfName(AName);
  If (I=-1) then
    Result:=Nil
  else
    Result:=GetNamedItem(I);
end;

function TNamedIniCollection.FindByUserData(UserData: TObject): TNamedIniCollectionItem;

Var
  I : Integer;

begin
  I:=IndexOfUserData(UserData);
  If (I=-1) then
    Result:=Nil
  else
    Result:=GetNamedItem(I);
end;

end.