{ This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or
  (at your option) any later version.
            
  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.  See the
  GNU General Public License for more details.
                    
  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

unit Config;

{ Unidad de configuracion
  Programa: John Coppens
  Descripcion:
    Inicializar el archivo de configuracion al principio del
    programa con
       <var>.Initialize(<nombre archivo>)
    Luego se puede acceder al contenido con los procedimientos:
       <var>.WriteString(<seccion>, <clave>, <valor>)
       <var>.WriteInteger(<seccion>, <clave>, <valor>)
       <var>.ReadString(<seccion>, <clave>, <valor defecto>): string;
       <var>.ReadInteger(<seccion>, <clave>, <valor defecto>): longint;
}

interface

uses
  CRT;

type
  PLine = ^TLine;
  TLine = object
    S: string[20];
    L: string;
    Nxt: PLine;
  end;

  TConfig = object
    F: text;
    Lin: PLine;

  { Funciones publicas }
    procedure Initialize(fn: string);
    procedure WriteString(Sec, Key, Value: string);
    procedure WriteInteger(Sec, Key: string; Value: longint);
    function  ReadString(Sec, Key, Def: string): string;
    function  ReadInteger(Sec, Key: string; Def: longint): longint;
  { Algunas funciones privadas }
    function  AddLine(S1, S2: string): PLine;
    function  FindLine(S, K: string): PLine;
    procedure WriteLines;
  end;

implementation

procedure TConfig.Initialize(fn: string);
var
  tLin: string;
  P: integer;
  tPtr: PLine;
begin
  Lin := nil;
  assign(F, fn);
  {$I-} reset(F); {$I+}
  if IOResult <> 0 then exit;
  while not eof(F) do begin
    readln(F, tLin);
    if (tLin = '') then continue;
    if (tLin[1] = ';') then continue;
    if (tLin[1] = '[') then
      tPtr := AddLine(tLin, '')
    else begin
      P := pos('=', tLin);
      if P = 0 then continue;
      tPtr := AddLine(copy(tLin, 1, P-1),
                      copy(tLin, P+1, length(tLin)-P));
    end;
  end;
  close(F);
end;

procedure TConfig.WriteString(Sec, Key, Value: string);
var
  tPtr, tNew: PLine;
begin
  tPtr := FindLine(Sec, Key);
                    { Detectar si seccion y clave ya estan en la tabla }
  if tPtr <> nil then
    tPtr^.L := Value                         { Seccion Y clave existen }
  else begin                                { Uno de los dos no existe }
    tPtr := FindLine(Sec, '');
    { Existe la seccion? }
    if tPtr = nil then                             { Seccion no existe }
       tPtr := AddLine('[' + Sec + ']', '');
    new(tNew);                               { Ahora la seccion existe }
    with tNew^ do begin                    { Insertamos la clave nueva }
      S := Key; L := Value;
      Nxt := tPtr^.Nxt;
    end;
    tPtr^.Nxt := tNew;
  end;
  WriteLines;
end;

procedure TConfig.WriteInteger(Sec, Key: string; Value: longint);
var
  S: string[50];
begin
  str(Value, S);
  WriteString(Sec, Key, S);
end;

function TConfig.ReadString(Sec, Key, Def: string): string;
var
  tPtr : PLine;
begin
  tPtr := FindLine(Sec, Key);
  if tPtr = nil then
    ReadString := Def
  else
    ReadString := tPtr^.L;
end;

function TConfig.ReadInteger(Sec, Key: string; Def: longint): longint;
var
  R: integer;
  T: longint;
  tPtr: Pline;
begin
  tPtr := FindLine(Sec, Key);
  if tPtr = nil then
    ReadInteger := Def
  else begin
    val(tPtr^.L, T, R);
    if R = 0 then
      ReadInteger := T
    else
      ReadInteger := Def;
  end;
end;

function TConfig.AddLine(S1, S2: string): PLine;
var
  tLin, tPtr: PLine;
begin
  new(tLin);
  with tLin^ do begin
    S := S1; L := S2;
    Nxt := nil;
  end;
  if Lin = nil then
    Lin := tLin
  else begin
    tPtr := Lin;
    while (tPtr^.Nxt <> nil) do     { Encontrar el final de la lista }
      tPtr := tPtr^.Nxt;
    tPtr^.Nxt := tLin;
  end;
  AddLine := tLin;
end;

function TConfig.FindLine(S, K: string): PLine;
var
  tPtr: PLine;
begin
  tPtr := Lin;
  FindLine := nil;
  { ------ Primer paso: encontrar la seccion }
  while (tPtr <> nil) and
        (tPtr^.S <> ('['+S+']')) do tPtr := tPtr^.Nxt;
  if tPtr = nil then exit;
  { Si la seccion se encontro, buscar clave si necesario (K <> '') }
  if (K = '') then begin
    FindLine := tPtr; exit;
  end;
  { ------ Buscamos la clave }
  tPtr := tPtr^.Nxt;
  while (tPtr <> nil) and                       { Si no es fin de lista }
        (tPtr^.S[1] <> '[') and            { y no es la proxima seccion }
        (tPtr^.S <> K) do tPtr := tPtr^.Nxt;        { seguimos buscando }
  if tPtr = nil then exit;
  if tPtr^.S[1] = '[' then exit;
  FindLine := tPtr;
end;

procedure TConfig.WriteLines;
var
  tPtr: PLine;
begin
  rewrite(F);
  tPtr := Lin;
  while (tPtr <> nil) do begin
    if tPtr^.S[1] = '[' then begin  { Es una seccion, dejar linea vacia }
      writeln(F);
      writeln(F, tPtr^.S);
    end
    else
      writeln(F, tPtr^.S, '=', tPtr^.L);
    tPtr := tPtr^.Nxt;
  end;
  close(F);
end;


begin
end.