{-------------------------------------------------------------------------------
 
 Copyright (c) 1999-2021 Ralf Junker, Yunqa
 Internet: https://www.yunqa.de
 E-Mail:   delphi@yunqa.de

-------------------------------------------------------------------------------}

unit DISQLite3IniFileDb;

{$I DICompilers.inc}
{$I DISQLite3.inc}

{$IFDEF DISQLite3_Personal}
!!! This file requires functionality unavailable in DISQLite3 Personal. !!!
!!! To compile, download DISQLite3 Pro from www.yunqa.de.               !!!
{$ENDIF DISQLite3_Personal}

interface

uses
  DISystemCompat,
  {$IFDEF HAS_UNITSCOPE}
  System.SysUtils, System.Classes,
  {$ELSE HAS_UNIT_SCOPE}
  SysUtils, Classes,
  {$ENDIF HAS_UNIT_SCOPE}
  {$IFDEF TntUnicode}TntClasses, {$ENDIF}
  DISQLite3Api;

const

  DEFAULT_LIST_ITEM_NAME = 'Item';

type

  EDISQLite3IniFileDb = class(Exception);

  TDISQLite3IniFileDb = class
  private
    FDb: sqlite3_ptr;
    FStmtDeleteKey: sqlite3_stmt_ptr;
    FStmtEraseSection: sqlite3_stmt_ptr;
    FStmtInsertKey: sqlite3_stmt_ptr;
    FStmtInsertSection: sqlite3_stmt_ptr;
    FStmtReadSection: sqlite3_stmt_ptr;
    FStmtReadSections: sqlite3_stmt_ptr;
    FStmtReadSectionValues: sqlite3_stmt_ptr;
    FStmtSelectKeyID: sqlite3_stmt_ptr;
    FStmtSelectValue: sqlite3_stmt_ptr;
    FStmtSelectSectionID: sqlite3_stmt_ptr;
    FStmtUpdateKey: sqlite3_stmt_ptr;
    FUpdateCount: Cardinal;
  protected
    function Check(const AErrorCode: Integer): Integer;
    procedure Execute(const ASQL8: Utf8String);
    function Prepare(const ASQL8: Utf8String): sqlite3_stmt_ptr;
    procedure RaiseException(const AErrorCode: Integer);
  public

    constructor Create(
      const AFileName: UnicodeString);

    destructor Destroy; override;

    procedure BeginUpdate;

    procedure Clear;

    procedure DeleteKey(
      const ASection, AKey: UnicodeString);

    procedure EndUpdate;

    procedure EraseSection(
      const ASection: UnicodeString);

    function InsertSection(
      const ASection: UnicodeString): Int64;

    function ReadInteger(
      const ASection, AKey: UnicodeString;
      const ADefault: Integer = 0): Integer;

    procedure ReadSection(
      const ASection: UnicodeString; AStrings: TStrings);

    procedure ReadSections(
      const AStrings: TStrings);

    procedure ReadSectionValues(
      const ASection: UnicodeString; AStrings: TStrings);

    function ReadString(
      const ASection, AKey: UnicodeString;
      const ADefault: UnicodeString = ''): UnicodeString;

    function ReadStringList(
      const ASection: UnicodeString;
      const AStringList: TStrings;
      const AClearFirst: Boolean = True;
      const AItemName: UnicodeString = DEFAULT_LIST_ITEM_NAME): Integer;

    {$IFDEF TntUnicode}
    function ReadTntStringList(
      const ASection: UnicodeString;
      const AStringList: TTntStrings;
      const AClearFirst: Boolean = True;
      const AItemName: UnicodeString = DEFAULT_LIST_ITEM_NAME): Integer;
    {$ENDIF TntUnicode}

    function SectionExists(
      const ASection: UnicodeString): Boolean;

    function SelectKeyID(
      const ASectionID: Int64;
      const AKey: UnicodeString): Int64;

    function SelectSectionID(
      const ASection: UnicodeString): Int64;

    function KeyExists(
      const ASection, AKey: UnicodeString): Boolean;

    procedure WriteInteger(
      const ASection, AKey: UnicodeString;
      const AValue: Integer);

    procedure WriteString(
      const ASection, AKey, AValue: UnicodeString);

    procedure WriteStringList(
      const ASection: UnicodeString;
      const AStringList: TStrings;
      const AItemName: UnicodeString = DEFAULT_LIST_ITEM_NAME);

    {$IFDEF TntUnicode}
    procedure WriteTntStringList(
      const ASection: UnicodeString;
      const AStringList: TTntStrings;
      const AItemName: UnicodeString = DEFAULT_LIST_ITEM_NAME);
    {$ENDIF TntUnicode}

    property UpdateCount: Cardinal read FUpdateCount;
  end;

implementation

const
  LIST_COUNT_SUFFIX =
    'Count';
  Sql_Insert_Key =
    'INSERT INTO Keys(SectionID,KeyName,KeyValue)VALUES(?,?,?);';
  Sql_Select_Value =
    'SELECT KeyValue FROM Keys NATURAL JOIN Sections ' +
    'WHERE SectionName=? AND KeyName=?;';
  Sql_Update_Key =
    'UPDATE Keys SET KeyValue=? WHERE KeyID=?;';

resourcestring
  SDISQLite3IniFileDbError = 'DISQLite3IniFileDb Error %d: %s';

constructor TDISQLite3IniFileDb.Create(const AFileName: UnicodeString);
begin
  Check(sqlite3_open(PUtf8Char(sqlite3_encode_utf8(AFileName)), @FDb));

  Execute('PRAGMA synchronous=off;');
  Execute('PRAGMA legacy_file_format=off;');

  Execute(
    'CREATE TABLE IF NOT EXISTS Sections(' +
    'SectionID INTEGER PRIMARY KEY,' +
    'SectionName TEXT UNIQUE COLLATE NoCase);');

  Execute(
    'CREATE TABLE IF NOT EXISTS Keys(' +
    'KeyID INTEGER PRIMARY KEY,' +
    'SectionID INTEGER,' +
    'KeyName TEXT COLLATE NoCase,' +
    'KeyValue TEXT,' +
    'UNIQUE(SectionID,KeyName));');

  Execute(
    'CREATE INDEX IF NOT EXISTS iKeySectionID ON Keys (SectionID);');

  Execute(
    'CREATE TRIGGER IF NOT EXISTS sd AFTER DELETE ON Sections ' +
    'BEGIN ' +
    'DELETE FROM Keys WHERE SectionID=old.SectionID;' +
    'END;');

  Execute(
    'CREATE TRIGGER IF NOT EXISTS su AFTER UPDATE ON Sections ' +
    'BEGIN ' +
    'UPDATE Keys SET SectionID=new.SectionID WHERE SectionID=old.SectionID;' +
    'END;');

  Execute(
    'CREATE TRIGGER IF NOT EXISTS k AFTER DELETE ON Keys ' +
    'WHEN NOT EXISTS (SELECT 0 FROM Keys WHERE SectionID=old.SectionID)' +
    'BEGIN ' +
    'DELETE FROM Sections WHERE SectionID = OLD.SectionID;' +
    'END;');
end;

destructor TDISQLite3IniFileDb.Destroy;
begin
  sqlite3_finalize(FStmtDeleteKey);
  sqlite3_finalize(FStmtEraseSection);
  sqlite3_finalize(FStmtInsertKey);
  sqlite3_finalize(FStmtInsertSection);
  sqlite3_finalize(FStmtReadSection);
  sqlite3_finalize(FStmtReadSections);
  sqlite3_finalize(FStmtReadSectionValues);
  sqlite3_finalize(FStmtSelectValue);
  sqlite3_finalize(FStmtSelectKeyID);
  sqlite3_finalize(FStmtSelectSectionID);
  sqlite3_finalize(FStmtUpdateKey);

  Check(sqlite3_close(FDb));
  inherited;
end;

procedure TDISQLite3IniFileDb.BeginUpdate;
begin
  if FUpdateCount = 0 then
    Execute('BEGIN TRANSACTION;');
  Inc(FUpdateCount);
end;

function TDISQLite3IniFileDb.Check(const AErrorCode: Integer): Integer;
begin
  Result := AErrorCode;
  case Result and $FF of
    SQLITE_OK, SQLITE_ROW, SQLITE_DONE:
      ;
  else
    RaiseException(AErrorCode);
  end;
end;

procedure TDISQLite3IniFileDb.Clear;
begin
  Execute('DELETE FROM Sections;');
  Execute('DELETE FROM Keys;');
end;

procedure TDISQLite3IniFileDb.DeleteKey(const ASection, AKey: UnicodeString);
const
  SQL = 'DELETE FROM Keys WHERE SectionID=(SELECT SectionID FROM Sections WHERE SectionName=?)AND KeyName =?';
begin
  if not Assigned(FStmtDeleteKey) then
    FStmtDeleteKey := Prepare(SQL);
  try
    Check(sqlite3_bind_str16(FStmtDeleteKey, 1, ASection));
    Check(sqlite3_bind_str16(FStmtDeleteKey, 2, AKey));
    Check(sqlite3_step(FStmtDeleteKey));
  finally
    sqlite3_reset(FStmtDeleteKey);
  end;
end;

procedure TDISQLite3IniFileDb.EndUpdate;
begin
  if FUpdateCount > 0 then
    begin
      Dec(FUpdateCount);
      if FUpdateCount = 0 then
        Execute('COMMIT TRANSACTION;');
    end;
end;

procedure TDISQLite3IniFileDb.EraseSection(const ASection: UnicodeString);
const
  SQL = 'DELETE FROM Sections WHERE SectionName=?;';
begin
  if not Assigned(FStmtEraseSection) then
    FStmtEraseSection := Prepare(SQL);
  try
    Check(sqlite3_bind_str16(FStmtEraseSection, 1, ASection));
    Check(sqlite3_step(FStmtEraseSection));
  finally
    sqlite3_reset(FStmtEraseSection);
  end;
end;

procedure TDISQLite3IniFileDb.Execute(const ASQL8: Utf8String);
var
  Stmt: sqlite3_stmt_ptr;
begin
  Stmt := Prepare(ASQL8);
  try
    Check(sqlite3_step(Stmt));
  finally
    sqlite3_finalize(Stmt);
  end;
end;

function TDISQLite3IniFileDb.InsertSection(const ASection: UnicodeString): Int64;
const
  Sql_Insert_Section = 'INSERT INTO Sections(SectionName)VALUES(?);';
begin
  if not Assigned(FStmtInsertSection) then
    FStmtInsertSection := Prepare(Sql_Insert_Section);
  try
    Check(sqlite3_bind_str16(FStmtInsertSection, 1, ASection));
    Check(sqlite3_step(FStmtInsertSection));
    Result := sqlite3_last_insert_rowid(FDb);
  finally
    sqlite3_reset(FStmtInsertSection);
  end;
end;

function TDISQLite3IniFileDb.KeyExists(const ASection, AKey: UnicodeString): Boolean;
begin
  Result := SelectKeyID(SelectSectionID(ASection), AKey) > 0;
end;

function TDISQLite3IniFileDb.Prepare(const ASQL8: Utf8String): sqlite3_stmt_ptr;
begin
  Check(sqlite3_prepare_v2(FDb, PUtf8Char(ASQL8), Length(ASQL8), @Result, nil));
end;

procedure TDISQLite3IniFileDb.RaiseException(const AErrorCode: Integer);
begin
  {$IFDEF COMPILER_5_UP}
  raise EDISQLite3IniFileDb.CreateResFmt(PResStringRec(@SDISQLite3IniFileDbError), [AErrorCode, sqlite3_errmsg(FDb)])
  {$ELSE}
  raise EDISQLite3IniFileDb.CreateFmt(SDISQLite3IniFileDbError, [AErrorCode, sqlite3_errmsg(FDb)])
  {$ENDIF}
end;

function TDISQLite3IniFileDb.ReadInteger(const ASection, AKey: UnicodeString; const ADefault: Integer = 0): Integer;
begin
  Result := ADefault;
  if not Assigned(FStmtSelectValue) then
    FStmtSelectValue := Prepare(Sql_Select_Value);
  try
    Check(sqlite3_bind_str16(FStmtSelectValue, 1, ASection));
    Check(sqlite3_bind_str16(FStmtSelectValue, 2, AKey));
    if Check(sqlite3_step(FStmtSelectValue)) = SQLITE_ROW then
      Result := sqlite3_column_int(FStmtSelectValue, 0);
  finally
    sqlite3_reset(FStmtSelectValue);
  end;
end;

procedure TDISQLite3IniFileDb.ReadSection(const ASection: UnicodeString; AStrings: TStrings);
const
  SQL = 'SELECT KeyName FROM Keys NATURAL JOIN Sections WHERE SectionName=?;';
begin
  AStrings.BeginUpdate;
  try
    if not Assigned(FStmtReadSection) then
      FStmtReadSection := Prepare(SQL);
    try
      Check(sqlite3_bind_str16(FStmtReadSection, 1, ASection));
      while Check(sqlite3_step(FStmtReadSection)) = SQLITE_ROW do
        AStrings.Add(sqlite3_column_str16(FStmtReadSection, 0));
    finally
      sqlite3_reset(FStmtReadSection);
    end;
  finally
    AStrings.EndUpdate;
  end;
end;

procedure TDISQLite3IniFileDb.ReadSections(const AStrings: TStrings);
const
  SQL = 'SELECT SectionName FROM Sections;';
begin
  AStrings.BeginUpdate;
  try
    if not Assigned(FStmtReadSections) then
      FStmtReadSections := Prepare(SQL);
    try
      while Check(sqlite3_step(FStmtReadSections)) = SQLITE_ROW do
        AStrings.Add(sqlite3_column_str16(FStmtReadSections, 0));
    finally
      sqlite3_reset(FStmtReadSections);
    end;
  finally
    AStrings.EndUpdate;
  end;
end;

procedure TDISQLite3IniFileDb.ReadSectionValues(const ASection: UnicodeString; AStrings: TStrings);
const
  SQL = 'SELECT KeyName, KeyValue FROM Keys NATURAL JOIN Sections WHERE SectionName=?;';
begin
  AStrings.BeginUpdate;
  try
    if not Assigned(FStmtReadSectionValues) then
      FStmtReadSectionValues := Prepare(SQL);
    try
      Check(sqlite3_bind_str16(FStmtReadSectionValues, 1, ASection));
      while Check(sqlite3_step(FStmtReadSectionValues)) = SQLITE_ROW do
        AStrings.Add(sqlite3_column_str16(FStmtReadSectionValues, 0) + '=' + sqlite3_column_str16(FStmtReadSectionValues, 1));
    finally
      sqlite3_reset(FStmtReadSectionValues);
    end;
  finally
    AStrings.EndUpdate;
  end;
end;

function TDISQLite3IniFileDb.ReadString(const ASection, AKey, ADefault: UnicodeString): UnicodeString;
begin
  Result := ADefault;
  if not Assigned(FStmtSelectValue) then
    FStmtSelectValue := Prepare(Sql_Select_Value);
  try
    Check(sqlite3_bind_str16(FStmtSelectValue, 1, ASection));
    Check(sqlite3_bind_str16(FStmtSelectValue, 2, AKey));
    if Check(sqlite3_step(FStmtSelectValue)) = SQLITE_ROW then
      Result := sqlite3_column_str16(FStmtSelectValue, 0);
  finally
    sqlite3_reset(FStmtSelectValue);
  end;
end;

function TDISQLite3IniFileDb.ReadStringList(
  const ASection: UnicodeString;
  const AStringList: TStrings;
  const AClearFirst: Boolean = True;
  const AItemName: UnicodeString = DEFAULT_LIST_ITEM_NAME): Integer;
var
  i: Integer;
begin
  AStringList.BeginUpdate;
  try
    if AClearFirst then
      AStringList.Clear;
    Result := ReadInteger(ASection, AItemName + LIST_COUNT_SUFFIX, 0);
    for i := 0 to Result - 1 do
      AStringList.Add(ReadString(ASection, AItemName + IntToStr(i)));
  finally
    AStringList.EndUpdate;
  end;
end;

{$IFDEF TntUnicode}

function TDISQLite3IniFileDb.ReadTntStringList(
  const ASection: UnicodeString;
  const AStringList: TTntStrings;
  const AClearFirst: Boolean = True;
  const AItemName: UnicodeString = DEFAULT_LIST_ITEM_NAME): Integer;
var
  i: Integer;
begin
  AStringList.BeginUpdate;
  try
    if AClearFirst then
      AStringList.Clear;
    Result := ReadInteger(ASection, AItemName + LIST_COUNT_SUFFIX, 0);
    for i := 0 to Result - 1 do
      AStringList.Add(ReadString(ASection, AItemName + IntToStr(i)));
  finally
    AStringList.EndUpdate;
  end;
end;

{$ENDIF TntUnicode}

function TDISQLite3IniFileDb.SectionExists(const ASection: UnicodeString): Boolean;
begin
  Result := SelectSectionID(ASection) > 0;
end;

function TDISQLite3IniFileDb.SelectKeyID(const ASectionID: Int64; const AKey: UnicodeString): Int64;
const
  Sql_Select_KeyID = 'SELECT KeyID FROM Keys WHERE SectionID=? AND KeyName=?;';
begin
  if not Assigned(FStmtSelectKeyID) then
    FStmtSelectKeyID := Prepare(Sql_Select_KeyID);
  try
    Check(sqlite3_bind_int64(FStmtSelectKeyID, 1, ASectionID));
    Check(sqlite3_bind_str16(FStmtSelectKeyID, 2, AKey));
    if Check(sqlite3_step(FStmtSelectKeyID)) = SQLITE_ROW then
      Result := sqlite3_column_int64(FStmtSelectKeyID, 0)
    else
      Result := -1;
  finally
    sqlite3_reset(FStmtSelectKeyID);
  end;
end;

function TDISQLite3IniFileDb.SelectSectionID(const ASection: UnicodeString): Int64;
const
  Sql_Select_SectionID = 'SELECT SectionID FROM Sections WHERE SectionName=?;';
begin
  if not Assigned(FStmtSelectSectionID) then
    FStmtSelectSectionID := Prepare(Sql_Select_SectionID);
  try
    Check(sqlite3_bind_str16(FStmtSelectSectionID, 1, ASection));
    if Check(sqlite3_step(FStmtSelectSectionID)) = SQLITE_ROW then
      Result := sqlite3_column_int64(FStmtSelectSectionID, 0)
    else
      Result := -1;
  finally
    sqlite3_reset(FStmtSelectSectionID);
  end;
end;

procedure TDISQLite3IniFileDb.WriteInteger(const ASection, AKey: UnicodeString; const AValue: Integer);
var
  KeyID: Int64;
  SectionID: Int64;
begin
  SectionID := SelectSectionID(ASection);
  if SectionID < 0 then
    SectionID := InsertSection(ASection);
  if SectionID >= 0 then
    begin
      KeyID := SelectKeyID(SectionID, AKey);
      if KeyID >= 0 then
        begin

          if not Assigned(FStmtUpdateKey) then
            FStmtUpdateKey := Prepare(Sql_Update_Key);
          try
            Check(sqlite3_bind_int(FStmtUpdateKey, 1, AValue));
            Check(sqlite3_bind_int64(FStmtUpdateKey, 2, KeyID));
            Check(sqlite3_step(FStmtUpdateKey))
          finally
            sqlite3_reset(FStmtUpdateKey);
          end;
        end
      else
        begin

          if not Assigned(FStmtInsertKey) then
            FStmtInsertKey := Prepare(Sql_Insert_Key);
          try
            Check(sqlite3_bind_int64(FStmtInsertKey, 1, SectionID));
            Check(sqlite3_bind_str16(FStmtInsertKey, 2, AKey));
            Check(sqlite3_bind_int(FStmtInsertKey, 3, AValue));
            Check(sqlite3_step(FStmtInsertKey))
          finally
            sqlite3_reset(FStmtInsertKey);
          end;
        end;
    end;
end;

procedure TDISQLite3IniFileDb.WriteString(const ASection, AKey, AValue: UnicodeString);
var
  KeyID: Int64;
  SectionID: Int64;
begin
  SectionID := SelectSectionID(ASection);
  if SectionID < 0 then
    SectionID := InsertSection(ASection);
  if SectionID >= 0 then
    begin
      KeyID := SelectKeyID(SectionID, AKey);
      if KeyID >= 0 then
        begin

          if not Assigned(FStmtUpdateKey) then
            FStmtUpdateKey := Prepare(Sql_Update_Key);
          try
            Check(sqlite3_bind_str16(FStmtUpdateKey, 1, AValue));
            Check(sqlite3_bind_int64(FStmtUpdateKey, 2, KeyID));
            Check(sqlite3_step(FStmtUpdateKey))
          finally
            sqlite3_reset(FStmtUpdateKey);
          end;
        end
      else
        begin

          if not Assigned(FStmtInsertKey) then
            FStmtInsertKey := Prepare(Sql_Insert_Key);
          try
            Check(sqlite3_bind_int64(FStmtInsertKey, 1, SectionID));
            Check(sqlite3_bind_str16(FStmtInsertKey, 2, AKey));
            Check(sqlite3_bind_str16(FStmtInsertKey, 3, AValue));
            Check(sqlite3_step(FStmtInsertKey))
          finally
            sqlite3_reset(FStmtInsertKey);
          end;
        end;
    end;
end;

procedure TDISQLite3IniFileDb.WriteStringList(
  const ASection: UnicodeString;
  const AStringList: TStrings;
  const AItemName: UnicodeString = DEFAULT_LIST_ITEM_NAME);
var
  i: Integer;
  PrevListCount: Integer;
begin
  PrevListCount := ReadInteger(ASection, AItemName + LIST_COUNT_SUFFIX, 0);
  WriteInteger(ASection, AItemName + LIST_COUNT_SUFFIX, AStringList.Count);
  for i := 0 to AStringList.Count - 1 do
    WriteString(ASection, AItemName + IntToStr(i), AStringList[i]);
  for i := AStringList.Count to PrevListCount - 1 do
    DeleteKey(ASection, AItemName + IntToStr(i));
end;

{$IFDEF TntUnicode}

procedure TDISQLite3IniFileDb.WriteTntStringList(
  const ASection: UnicodeString;
  const AStringList: TTntStrings;
  const AItemName: UnicodeString = DEFAULT_LIST_ITEM_NAME);
var
  i: Integer;
  PrevListCount: Integer;
begin
  PrevListCount := ReadInteger(ASection, AItemName + LIST_COUNT_SUFFIX, 0);
  WriteInteger(ASection, AItemName + LIST_COUNT_SUFFIX, AStringList.Count);
  for i := 0 to AStringList.Count - 1 do
    WriteString(ASection, AItemName + IntToStr(i), AStringList[i]);
  for i := AStringList.Count to PrevListCount - 1 do
    DeleteKey(ASection, AItemName + IntToStr(i));
end;

{$ENDIF TntUnicode}

end.

