lasarus_compotents/spktoolbar/SpkXML/SpkXMLIni.pas

unit SpkXMLIni;

{$mode ObjFpc}
{$H+}

{$DEFINE SPKXMLINI}

interface

uses SpkXMLParser, classes, sysutils;

type TSpkXMLIni = class(TObject)
     private
       FParser : TSpkXMLParser;
       FAutoConvert : boolean;
     protected
     public
       constructor Create; overload;
       constructor Create(filename : string); overload;
       destructor Destroy; override;
       procedure LoadFromFile(filename : string);
       procedure SaveToFile(filename : string);
       procedure SaveToStream(AStream : TStream);
       procedure LoadFromStream(AStream : TStream);
       procedure Clear;
       procedure DeleteKey(const Section, Ident: string);
       procedure EraseSection(const Section: string);
       function ReadString(const Section, Ident, Default: string): string;
       procedure WriteString(const Section, Ident, Value: string);
       function ReadBool (const Section, Ident: String; Default: Boolean): Boolean;
       function ReadDate (const Section, Ident: string; Default: TDateTime): TDateTime;
       function ReadDateTime (const Section, Ident: String; Default: TDateTime): TDateTime;
       function ReadFloat (const Section, Ident: String; Default: Double): Double;
       function ReadInteger(const Section, Ident: String; Default: Longint): Longint;
       function ReadTime (const Section, Ident: String; Default: TDateTime): TDateTime;
       function SectionExists (const Section: String): Boolean;
       procedure WriteBool(const Section, Ident: String; Value: Boolean);
       procedure WriteDate(const Section, Ident: String; Value: TDateTime);
       procedure WriteDateTime(const Section, Ident: String; Value: TDateTime);
       procedure WriteFloat(const Section, Ident: String; Value: Double);
       procedure WriteInteger(const Section, Ident: String; Value: Longint);
       procedure WriteTime(const Section, Ident: String; Value: TDateTime);
       function ValueExists(const section, ident : string) : boolean;
       procedure WriteStrings(const Section, Ident : String; Value : TStrings);
       procedure ReadStrings(const Section, Ident : String; Target : TStrings);
       procedure ReadSection (const Section: string; Strings: TStrings);
       procedure ReadSections(Strings: TStrings);
       procedure ReadSectionValues(const Section: string; Strings: TStrings);

       property AutoConvert : boolean read FAutoConvert write FAutoConvert;
     end;

implementation

{ TSpkXMLIni }

constructor TSpkXMLIni.create;

begin
  inherited create;
  FParser:=TSpkXMLParser.create;
  FAutoConvert:=true;
end;

constructor TSpkXMLIni.create(filename : string);

begin
inherited create;
self.LoadFromFile(filename);
end;

destructor TSpkXMLIni.destroy;

begin
  FParser.free;
  inherited;
end;

procedure TSpkXMLIni.LoadFromFile(filename : string);

begin
try
FParser.LoadFromFile(filename);
except
self.clear;
end;
end;

procedure TSpkXMLIni.LoadFromStream(AStream: TStream);
begin
FParser.LoadFromStream(AStream);
end;

procedure TSpkXMLIni.SaveToFile(filename : string);

begin
FParser.SaveToFile(filename);
end;

procedure TSpkXMLIni.SaveToStream(AStream: TStream);
begin
FParser.SaveToStream(AStream);
end;

procedure TSpkXMLIni.Clear;

begin
FParser.Clear;
end;

procedure TSpkXMLIni.DeleteKey(const Section, Ident: string);

var node : TSpkXMLNode;
    subnode : TSpkXMLNode;

begin
node:=FParser.NodeByName[Section,false];
if node<>nil then
   begin
   subnode:=node.NodeByName[Ident,false];
   if subnode<>nil then
      begin
      node.delete(node.IndexOf(subnode));
      end;
   end;
end;

procedure TSpkXMLIni.EraseSection(const Section: string);

var node : TSpkXMLNode;

begin
node:=FParser.NodeByName[Section,false];
if node<>nil then
   Fparser.Delete(FParser.IndexOf(node));
end;

function TSpkXMLIni.ReadString(const Section, Ident, Default: string): string;

var node, subnode : TSpkXMLNode;

begin
node:=FParser.NodeByName[Section,false];
if node=nil then result:=Default else
   begin
   subnode:=node.NodeByName[Ident,false];
   if subnode=nil then result:=Default else
      begin
      if subnode.Parameters.ParamByName['type',false]<>nil then
         begin
         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='STRING' then
            result:=subnode.text else
            begin
            if FAutoConvert then
               try
               result:=subnode.text;
               except
               result:=Default;
               end else raise exception.create('Invalid object type!');
            end;
         end else result:=subnode.Text;
      end;
   end;
end;

procedure TSpkXMLIni.WriteString(const Section, Ident, Value: string);

begin
self.DeleteKey(Section,Ident);
FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].value:='string';
FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=Value;
end;

function TSpkXMLIni.ReadBool (const Section, Ident: String; Default: Boolean): Boolean;

var node, subnode : TSpkXMLNode;

begin
node:=FParser.NodeByName[Section,false];
if node=nil then result:=Default else
   begin
   subnode:=node.NodeByName[Ident,false];
   if subnode=nil then result:=Default else
      begin
      if subnode.Parameters.ParamByName['type',false]<>nil then
         begin
         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='BOOLEAN' then
            begin
            if (uppercase(subnode.text)='TRUE') or (subnode.text='1') then result:=true else result:=false;
            end else
                begin
                if FAutoConvert then
                   try
                   if (uppercase(subnode.text)='TRUE') or (subnode.text='1') then result:=true else result:=false;
                   except
                   result:=Default;
                   end else raise exception.create('Invalid object type!');
                end;
         end else
             try
             if (uppercase(subnode.text)='TRUE') or (subnode.text='1') then result:=true else result:=false;
             except
             result:=Default;
             end;
      end;
   end;
end;

function TSpkXMLIni.ReadDate (const Section, Ident: string; Default: TDateTime): TDateTime;

var node, subnode : TSpkXMLNode;

begin
node:=FParser.NodeByName[Section,false];
if node=nil then result:=Default else
   begin
   subnode:=node.NodeByName[Ident,false];
   if subnode=nil then result:=Default else
      begin
      if subnode.Parameters.ParamByName['type',false]<>nil then
         begin
         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='DATE' then
            begin
            try
            result:=StrToDate(subnode.text);
            except
            result:=Default;
            end;
            end else
                begin
                if FAutoConvert then
                   try
                   result:=StrToDate(subnode.text);
                   except
                   result:=Default;
                   end else raise exception.create('Invalid object type!');
                end;
         end else
             try
             result:=StrToDate(subnode.text);
             except
             result:=Default;
             end;
      end;
   end;
end;

function TSpkXMLIni.ReadDateTime (const Section, Ident: String; Default: TDateTime): TDateTime;

var node, subnode : TSpkXMLNode;

begin
node:=FParser.NodeByName[Section,false];
if node=nil then result:=Default else
   begin
   subnode:=node.NodeByName[Ident,false];
   if subnode=nil then result:=Default else
      begin
      if subnode.Parameters.ParamByName['type',false]<>nil then
         begin
         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='DATETIME' then
            begin
            try
            result:=StrToDateTime(subnode.text);
            except
            result:=Default;
            end;
            end else
                begin
                if FAutoConvert then
                   try
                   result:=StrToDateTime(subnode.text);
                   except
                   result:=Default;
                   end else raise exception.create('Invalid object type!');
                end;
         end else
             try
             result:=StrToDateTime(subnode.text);
             except
             result:=Default;
             end;
      end;
   end;
end;

function TSpkXMLIni.ReadFloat (const Section, Ident: String; Default: Double): Double;

var node, subnode : TSpkXMLNode;

begin
node:=FParser.NodeByName[Section,false];
if node=nil then result:=Default else
   begin
   subnode:=node.NodeByName[Ident,false];
   if subnode=nil then result:=Default else
      begin
      if subnode.Parameters.ParamByName['type',false]<>nil then
         begin
         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='FLOAT' then
            begin
            try
            result:=StrToFloat(subnode.text);
            except
            result:=Default;
            end;
            end else
                begin
                if FAutoConvert then
                   try
                   result:=StrToFloat(subnode.text);
                   except
                   result:=Default;
                   end else raise exception.create('Invalid object type!');
                end;
         end else
             try
             result:=StrToFloat(subnode.text);
             except
             result:=Default;
             end;
      end;
   end;
end;

function TSpkXMLIni.ReadInteger(const Section, Ident: String; Default: Longint): Longint;

var node, subnode : TSpkXMLNode;

begin
node:=FParser.NodeByName[Section,false];
if node=nil then result:=Default else
   begin
   subnode:=node.NodeByName[Ident,false];
   if subnode=nil then result:=Default else
      begin
      if subnode.Parameters.ParamByName['type',false]<>nil then
         begin
         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='FLOAT' then
            begin
            try
            result:=StrToInt(subnode.text);
            except
            result:=Default;
            end;
            end else
                begin
                if FAutoConvert then
                   try
                   result:=StrToInt(subnode.text);
                   except
                   result:=Default;
                   end else raise exception.create('Invalid object type!');
                end;
         end else
             try
             result:=StrToInt(subnode.text);
             except
             result:=Default;
             end;
      end;
   end;
end;

function TSpkXMLIni.ReadTime (const Section, Ident: String; Default: TDateTime): TDateTime;

var node, subnode : TSpkXMLNode;

begin
node:=FParser.NodeByName[Section,false];
if node=nil then result:=Default else
   begin
   subnode:=node.NodeByName[Ident,false];
   if subnode=nil then result:=Default else
      begin
      if subnode.Parameters.ParamByName['type',false]<>nil then
         begin
         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='TIME' then
            begin
            try
            result:=StrToTime(subnode.text);
            except
            result:=Default;
            end;
            end else
                begin
                if FAutoConvert then
                   try
                   result:=StrToTime(subnode.text);
                   except
                   result:=Default;
                   end else raise exception.create('Invalid object type!');
                end;
         end else
             try
             result:=StrToTime(subnode.text);
             except
             result:=Default;
             end;
      end;
   end;
end;

function TSpkXMLIni.SectionExists (const Section: String): Boolean;

begin
result:=FParser.NodeByName[Section,false]<>nil;
end;

procedure TSpkXMLIni.WriteBool(const Section, Ident: String; Value: Boolean);

begin
self.DeleteKey(Section,Ident);
FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='boolean';
if Value then FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:='true' else
   FParser.NodeByName[Section,true].NodeByName[Ident,true].text:='false';
end;

procedure TSpkXMLIni.WriteDate(const Section, Ident: String; Value: TDateTime);

begin
self.DeleteKey(Section,Ident);
FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='date';
FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=DateToStr(Value);
end;

procedure TSpkXMLIni.WriteDateTime(const Section, Ident: String; Value: TDateTime);

begin
self.DeleteKey(Section,Ident);
FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='datetime';
FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=DateTimeToStr(Value);
end;

procedure TSpkXMLIni.WriteFloat(const Section, Ident: String; Value: Double);

begin
self.DeleteKey(Section,Ident);
FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='float';
FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=FloatToStr(Value);
end;

procedure TSpkXMLIni.WriteInteger(const Section, Ident: String; Value: Longint);

begin
self.DeleteKey(Section,Ident);
FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='integer';
FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=IntToStr(Value);
end;

procedure TSpkXMLIni.WriteTime(const Section, Ident: String; Value: TDateTime);

begin
self.DeleteKey(Section,Ident);
FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='time';
FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=TimeToStr(Value);
end;

function TSpkXMLIni.ValueExists(const section, ident : string) : boolean;

begin
result:=FParser.NodeByName[section,false]<>nil;
if result then
   result:=result and (FParser.NodeByName[section,false].NodeByName[ident,false]<>nil);
end;

procedure TSpkXMLIni.WriteStrings(const Section, Ident : String; Value : TStrings);

var node,subnode : TSpkXMLNode;
    i : integer;

begin
self.DeleteKey(Section,Ident);
node:=FParser.NodeByName[Section,true];
subnode:=node.NodeByName[ident,true];
subnode.Parameters.ParamByName['type',true].value:='strings';
subnode.parameters.parambyname['count',true].value:=IntToStr(Value.count);
for i:=0 to value.count-1 do
    begin
    subnode.NodeByName['line'+IntToStr(i),true].text:=Value[i];
    end;
end;

procedure TSpkXMLIni.ReadStrings(const Section, Ident : String; Target : TStrings);

var node, subnode, line : TSpkXMLNode;
    i,count : integer;

begin
target.clear;

node:=FParser.NodeByName[Section,false];
if node=nil then exit;

subnode:=node.NodeByName[ident,false];
if subnode=nil then exit;

if subnode.Parameters.ParamByName['type',false]=nil then exit;
if uppercase(subnode.Parameters.ParamByName['type',false].value)<>'STRINGS' then exit;

if subnode.parameters.parambyname['count',false]=nil then exit;

try
count:=StrToInt(subnode.parameters.parambyname['count',false].Value);
except
exit
end;

for i:=0 to count-1 do
    begin
    line:=subnode.NodeByName['line'+IntToStr(i),false];
    if line=nil then
       begin
       target.Clear;
       exit;
       end;
    target.Add(line.Text);
    end;
end;

procedure TSpkXMLIni.ReadSection(const Section: string; Strings: TStrings);

var i : integer;
    node : TSpkXMLNode;

begin
if FParser.NodeByName[Section,false]=nil then exit;
node:=FParser.NodeByName[Section,false];
if node.Count=0 then exit;
for i:=0 to node.Count-1 do
    Strings.Add(node.NodeByIndex[i].Name);
end;

procedure TSpkXMLIni.ReadSections(Strings: TStrings);

var i : integer;

begin
if FParser.count=0 then exit;
for i:=0 to FParser.count-1 do
    Strings.add(FParser.NodeByIndex[i].Name);
end;

procedure TSpkXMLIni.ReadSectionValues(const Section: string; Strings: TStrings);

var i : integer;
    node : TSpkXMLNode;

begin
if FParser.NodeByName[Section,false]=nil then exit;
node:=FParser.NodeByName[Section,false];
if node.Count=0 then exit;
for i:=0 to node.count-1 do
    begin
    {$I-}
    if (node.NodeByIndex[i].Parameters.ParamByName['type',false]<>nil) and
       (uppercase(node.NodeByIndex[i].Parameters.ParamByName['type',false].Value)='STRINGS') then
       Strings.add('[TStrings]')
       else
       Strings.add(node.NodeByIndex[i].Text);
    end;
end;

end.