unit uConfig;

interface

uses Classes, LibXmlParser, LibXmlComps;

type TConfig = class
     private
           Properties: TList;
           XMLScanner: TXMLScanner;
           Source: String;

           // Procedures triggered by the XML SAX Parser
           procedure XMLEmptyTag( Sender: TObject; Name: String; Attributes: TAttrList );
           function FindPair( Key: String ): Pointer;
     public
           constructor Create;
           destructor Free;

           // Load && Save
           procedure Load( Path: String );
           procedure Save( Path: String );
           procedure Clear;

           // Get & Set Stuff
           function GetString( Name: String ): String;
           function GetBool( Name: String ): Boolean;
           function GetInteger( Name: String ): Integer;

           procedure SetString( Name: String; Value: String );
           procedure SetBool( Name: String; Value: Boolean );
           procedure SetInteger( Name: String; Value: Integer );
end;

var
   Config: TConfig;

implementation

uses Windows, SysUtils;

// Datatypes for storing Configuration information
// in Memory
type TPair = record
     Key: String;
     Value: String;
end;

type PPair = ^TPair;

// Constructor
constructor TConfig.Create;
begin
     Properties := TList.Create;
     XMLScanner := TXmlScanner.Create( nil );
end;

// Clear the currently loaded configuration data
procedure TConfig.Clear;
begin
     while( Properties.Count > 0 ) do
     begin
          dispose( Properties[0] );
          Properties.Delete( 0 );
     end;
end;

// Destructor
destructor TConfig.Free;
begin
     Clear;
     Properties.Free;
     XMLScanner.Free;
end;

// Load the configuration file
procedure TConfig.Load( Path: String );
begin
     Source := Path;
     XMLScanner.LoadFromFile( Path );
     XMLScanner.OnEmptyTag := XMLEmptyTag;
     XMLScanner.Execute;
end;

// Write out a Configuration file
procedure TConfig.Save( Path: String );
var
    Output: TextFile;
    i: Integer;
    Pair: PPair;
    Line: String;
begin
    Source := Path;
    AssignFile( Output, Path );
    Rewrite( Output );

    WriteLn( Output, '<configuration>' );

    for i := 0 to Properties.Count-1 do
    begin
        Pair := Properties[i];
        Line := '<config key="' + Pair.Key + '" value="' + Pair.Value + '" />';
        WriteLn( Output, Line );
    end;

    WriteLn( Output, '</configuration>' );
    CloseFile( Output );
end;

// A XML Tag was found
procedure TConfig.XMLEmptyTag( Sender: TObject; Name: String; Attributes: TAttrList );
var
   Pair: PPair;
begin
     if( Name <> 'config' ) then
         exit;

     // Read key + value attributes
     if( ( Attributes.Node( 'key' ) <> nil ) and ( Attributes.Node( 'value' ) <> nil ) ) then
     begin
          new( Pair );
          Pair.Key := Attributes.Node( 'key' ).Value;
          Pair.Value := Attributes.Node( 'value' ).Value;
          Properties.Add( Pair );
     end;
end;

function TConfig.GetString( Name: String ): String;
var
   Pair: PPair;
begin
   Pair := FindPair( Name );

   if( Pair <> nil ) then
       Result := Pair.Value
   else
       Result := '';
end;

function TConfig.GetBool( Name: String ): Boolean;
var
   Pair: PPair;
begin
   Pair := FindPair( Name );

   if( Pair <> nil ) then
       Result := StrToBoolDef( Pair.Value, false )
   else
       Result := false;
end;

function TConfig.GetInteger( Name: String ): Integer;
var
   Pair: PPair;
begin
   Pair := FindPair( Name );

   if( Pair <> nil ) then
       Result := StrToIntDef( Pair.Value, 0 )
   else
       Result := 0;
end;

procedure TConfig.SetString( Name: String; Value: String );
var
    Pair: PPair;
begin
   Pair := FindPair( Name );
   if Pair <> nil then
        Pair.Value := Value
   else
   begin
        new( Pair );
        Pair.Key := Name;
        Pair.Value := Value;
        Properties.Add( Pair );
   end;

   Save( Source );
end;

procedure TConfig.SetBool( Name: String; Value: Boolean );
var
    Pair: PPair;
begin
   Pair := FindPair( Name );
   if Pair <> nil then
        Pair.Value := BoolToStr( Value )
   else
   begin
        new( Pair );
        Pair.Key := Name;
        Pair.Value := BoolToStr( Value );
        Properties.Add( Pair );
   end;

   Save( Source );
end;

procedure TConfig.SetInteger( Name: String; Value: Integer );
var
    Pair: PPair;
begin
   Pair := FindPair( Name );
   if Pair <> nil then
        Pair.Value := IntToStr( Value )
   else
   begin
        new( Pair );
        Pair.Key := Name;
        Pair.Value := IntToStr( Value );
        Properties.Add( Pair );
   end;

   Save( Source );
end;

function TConfig.FindPair( Key: String ): Pointer;
var
   i: Integer;
begin
     for i := 0 to Properties.Count-1 do
          if( PPair( Properties[i] ).Key = Key ) then
          begin
              Result := Properties[i];
              exit;
          end;

     Result := nil;
end;

end.
