unit uStringIniFile;

// this code is under the BAF fair use license (BFUL) - https://bafbal.de/index.php?title=Bful
// an ini file you can access with AsString

interface

uses System.SysUtils, System.Classes, System.IniFiles;

type
  THashedStringList2 = class(THashedStringList)
  protected
    procedure Changed; override;
  end;

  TStringIniFile = class(TCustomIniFile)
  private
    function GetSectionCount: integer;
    function GetAsString: string;
    procedure SetAsString(const Value: string);
    function GetSections(aIndex: integer): string;
  protected
    FSections: TStringList;
    FEncoding: TEncoding;
    function AddSection(const Section: string): TStrings;
    function GetCaseSensitive: Boolean;
    procedure LoadValues;
    procedure SetCaseSensitive(Value: Boolean);
  public
    constructor Create(const AFileName: string; AEscapeLineFeeds : Boolean = False);
    destructor Destroy; override;
    procedure Clear;
    procedure DeleteKey(const Section, Ident: String); override;
    procedure EraseSection(const Section: string); override;
    procedure GetStrings(List: TStrings);
    procedure ReadSection(const Section: string; Strings: TStrings); override;
    procedure ReadSections(Strings: TStrings); override;
    procedure ReadSectionValues(const Section: string; Strings: TStrings); override;
    function ReadString(const Section, Ident, Default: string): string; override;
    procedure SetStrings(List: TStrings);
    procedure WriteString(const Section, Ident, Value: string); override;
    procedure WriteStringNotEmpty(const Section, Ident, Value: string);
    property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive;
    {in addition to TMemIniFiles :}
    property AsString: string read GetAsString write SetAsString;
    property SectionCount: integer read GetSectionCount;
    property Sections[aIndex: integer]: string read GetSections;
    function ReadBoolJN(const Section, Ident: string; Default: Boolean): Boolean; virtual;
    procedure WriteBoolJN(const Section, Ident: string; Value: Boolean); virtual;
    function GetCompleteSection(const aSection: string): TStrings;
    procedure Strings2Ini(AStrings: TStrings; AKat: string);
    procedure Ini2Strings(AStrings: TStrings; AKat: string);
    {}
    procedure UpdateFile; override;
    property Encoding: TEncoding read FEncoding write FEncoding;
  end;

var
  GStringIniFileResult: string;

implementation

constructor TStringIniFile.Create(const AFileName: string; AEscapeLineFeeds : Boolean = False);
begin
  inherited Create(AFileName);
  FEncoding := Encoding;
  FSections := THashedStringList.Create;
{$IFDEF LINUX}
  FSections.CaseSensitive := True;
{$ENDIF}
  LoadValues;
end;

destructor TStringIniFile.Destroy;
begin
  GStringIniFileResult := AsString;
  if FSections <> nil then
    Clear;
  FSections.Free;
  inherited Destroy;
end;

function TStringIniFile.AddSection(const Section: string): TStrings;
begin
  Result := THashedStringList.Create;
  try
    THashedStringList(Result).CaseSensitive := CaseSensitive;
    FSections.AddObject(Section, Result);
  except
    Result.Free;
    raise;
  end;
end;

procedure TStringIniFile.Clear;
{$IFNDEF AUTOREFCOUNT}
var
  I: Integer;
{$ENDIF !AUTOREFCOUNT}
begin
{$IFNDEF AUTOREFCOUNT}
  for I := 0 to FSections.Count - 1 do
  begin
    FSections.Objects[I].Free;
  end;
{$ENDIF !AUTOREFCOUNT}
  FSections.Clear;
end;

procedure TStringIniFile.DeleteKey(const Section, Ident: String);
var
  I, J: Integer;
  Strings: TStrings;
begin
  I := FSections.IndexOf(Section);
  if I >= 0 then
  begin
    Strings := TStrings(FSections.Objects[I]);
    J := Strings.IndexOfName(Ident);
    if J >= 0 then
      Strings.Delete(J);
  end;
end;

procedure TStringIniFile.EraseSection(const Section: string);
var
  I: Integer;
begin
  I := FSections.IndexOf(Section);
  if I >= 0 then
  begin
{$IFNDEF AUTOREFCOUNT}
    FSections.Objects[I].Free;
{$ENDIF !AUTOREFCOUNT}
    FSections.Delete(I);
  end;
end;

function TStringIniFile.GetAsString: string;
var
    sl: TStringList;
begin
    sl := TStringList.Create;
    try
        GetStrings(sl);
        result := sl.Text;
    finally
        sl.Free;
    end;
end;

function TStringIniFile.GetCaseSensitive: Boolean;
begin
  Result := FSections.CaseSensitive;
end;

function TStringIniFile.GetSectionCount: integer;
begin
    result := FSections.Count;
end;

function TStringIniFile.GetSections(aIndex: integer): string;
begin
    result := FSections[aIndex];
end;

procedure TStringIniFile.GetStrings(List: TStrings);
var
  I, J: Integer;
  Strings: TStrings;
begin
  List.BeginUpdate;
  try
    for I := 0 to FSections.Count - 1 do
    begin
      List.Add('[' + FSections[I] + ']');
      Strings := TStrings(FSections.Objects[I]);
      for J := 0 to Strings.Count - 1 do List.Add(Strings[J]);
      List.Add('');
    end;
  finally
    List.EndUpdate;
  end;
end;

procedure TStringIniFile.Ini2Strings(AStrings: TStrings; AKat: string);
var
  i, LCount: integer;
begin
  LCount := ReadInteger(AKat, 'Count', 0);
  AStrings.Clear;
  for i := 1 to LCount do
    AStrings.Add(ReadString(AKat, 'Line_' + IntToStr(i), ''));
end;

procedure TStringIniFile.LoadValues;
var
  Size: Integer;
  Buffer: TBytes;
  List: TStringList;
  Stream: TFileStream;
begin
  if (FileName <> '') and FileExists(FileName) then
  begin
    Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
    try
     // Load file into buffer and detect encoding
      Size := Stream.Size - Stream.Position;
      SetLength(Buffer, Size);
      Stream.Read(Buffer[0], Size);
      Size := TEncoding.GetBufferEncoding(Buffer, FEncoding);

      // Load strings from buffer
      List := TStringList.Create;
      try
        List.Text := FEncoding.GetString(Buffer, Size, Length(Buffer) - Size);
        SetStrings(List);
      finally
        List.Free;
      end;
    finally
      Stream.Free;
    end;
  end
  else
    Clear;
end;

function TStringIniFile.ReadBoolJN(const Section, Ident: string;
  Default: Boolean): Boolean;
const
  Values: array[Boolean] of string = ('N', 'J');
begin
  Result := (ReadString(Section, Ident, Values[Default]) + ' ')[1] in ['J', 'j', '1', 'Y', 'y'];
end;

procedure TStringIniFile.ReadSection(const Section: string;
  Strings: TStrings);
var
  I, J: Integer;
  SectionStrings: TStrings;
begin
  Strings.BeginUpdate;
  try
    Strings.Clear;
    I := FSections.IndexOf(Section);
    if I >= 0 then
    begin
      SectionStrings := TStrings(FSections.Objects[I]);
      for J := 0 to SectionStrings.Count - 1 do
        Strings.Add(SectionStrings.Names[J]);
    end;
  finally
    Strings.EndUpdate;
  end;
end;

procedure TStringIniFile.ReadSections(Strings: TStrings);
begin
  Strings.Assign(FSections);
end;

procedure TStringIniFile.ReadSectionValues(const Section: string;
  Strings: TStrings);
var
  I: Integer;
begin
  Strings.BeginUpdate;
  try
    Strings.Clear;
    I := FSections.IndexOf(Section);
    if I >= 0 then
      Strings.Assign(TStrings(FSections.Objects[I]));
  finally
    Strings.EndUpdate;
  end;
end;

function TStringIniFile.ReadString(const Section, Ident,
  Default: string): string;
var
  I: Integer;
  Strings: TStrings;
begin
  I := FSections.IndexOf(Section);
  if I >= 0 then
  begin
    Strings := TStrings(FSections.Objects[I]);
    I := Strings.IndexOfName(Ident);
    if I >= 0 then
    begin
      Result := Strings[I].SubString( Ident.Length + 1);
      Exit;
    end;
  end;
  Result := Default;
end;

procedure TStringIniFile.SetAsString(const Value: string);
var
    sl: TStringList;
begin
    sl := TStringList.Create;
    try
        sl.Text := Value;
        SetStrings(sl);
    finally
        sl.Free;
    end;
end;

procedure TStringIniFile.SetCaseSensitive(Value: Boolean);
var
  I: Integer;
begin
  if Value <> FSections.CaseSensitive then
  begin
    FSections.CaseSensitive := Value;
    for I := 0 to FSections.Count - 1 do
    begin
      THashedStringList2(FSections.Objects[I]).CaseSensitive := Value;
      THashedStringList2(FSections.Objects[I]).Changed;
    end;
    THashedStringList2(FSections).Changed;
  end;
end;

procedure TStringIniFile.SetStrings(List: TStrings);
var
  I, J: Integer;
  S: string;
  Strings: TStrings;
begin
  Clear;
  Strings := nil;
  for I := 0 to List.Count - 1 do
  begin
    S := List[I].Trim;
    if (S <> '') and (S.Chars[0] <> ';') then
      if (S.Chars[0] = '[') and (S.Chars[S.Length-1] = ']') then
      begin
        // Remove Brackets
        Strings := AddSection(S.Substring(1, S.Length-2).Trim);
      end
      else
        if Strings <> nil then
        begin
          J := S.IndexOf('=');
          if J >= 0 then // remove spaces before and after '='
            Strings.Add(S.SubString(0, J).Trim + '=' + S.SubString( J+1).Trim)
          else
            Strings.Add(S);
        end;
  end;
end;

procedure TStringIniFile.Strings2Ini(AStrings: TStrings; AKat: string);
var
  i: integer;
begin
  WriteInteger(AKat, 'Count', AStrings.Count);
  for i := 1 to AStrings.Count do
    WriteString(AKat, 'Line_' + IntToStr(i), AStrings[i - 1]);
end;

procedure TStringIniFile.UpdateFile;
var
  List: TStringList;
begin
  List := TStringList.Create;
  try
    GetStrings(List);
    List.SaveToFile(FileName, FEncoding);
  finally
    List.Free;
  end;
end;

procedure TStringIniFile.WriteBoolJN(const Section, Ident: string;
  Value: Boolean);
const
  Values: array[Boolean] of string = ('N', 'J');
begin
  WriteString(Section, Ident, Values[Value]);
end;

procedure TStringIniFile.WriteString(const Section, Ident, Value: String);
var
  I: Integer;
  S: string;
  Strings: TStrings;
begin
  I := FSections.IndexOf(Section);
  if I >= 0 then
    Strings := TStrings(FSections.Objects[I])
  else
    Strings := AddSection(Section);
  S := Ident + '=' + Value;
  I := Strings.IndexOfName(Ident);
  if I >= 0 then
    Strings[I] := S
  else
    Strings.Add(S);
end;

procedure TStringIniFile.WriteStringNotEmpty(const Section, Ident, Value: string);
begin
  if Value <> '' then
    WriteString(Section, Ident, Value);
end;

function TStringIniFile.GetCompleteSection(const aSection: string): TStrings;
var
  i: integer;
begin
  result := nil;
  i := FSections.IndexOf(aSection);
  if i >= 0 then
    result := TStrings(FSections.Objects[I]);
end;


{ THashedStringList22 }

procedure THashedStringList2.Changed;
begin
  inherited;
end;

end.
