uSQLiteIni

unit uSQLiteIni;

interface

uses
  Winapi.Windows, System.SysUtils, System.UITypes, Vcl.Forms, System.Classes, System.Variants,
  FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Stan.Def,
  FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.SQLite, FireDAC.Stan.ExprFuncs,
  FireDAC.VCLUI.Wait, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt, Data.DB, FireDAC.Comp.Client;

const
  DBJOURNAL_POSTFIX = '-journal';

type
  TSQLiteIni = class
  private
    fConnection: TFDConnection;
  public
    constructor Create(const FileName: string; const Password: string = '');
    destructor Destroy; override;
    function Read(const Section, Variable: string; const DefaultValue: Variant): Variant;
    procedure Write(const Section, Variable: string; const Value: Variant);
  end;

implementation

uses
  uCommon;

procedure nop;
asm
end;

constructor TSQLiteIni.Create(const FileName: string; const Password: string = '');
begin
  if FileExists(FileName + DBJOURNAL_POSTFIX) then
    DeleteFile(FileName + DBJOURNAL_POSTFIX);
  if not DirectoryExists(ExtractFileDir(FileName)) then
    ForceDirectories(ExtractFileDir(FileName));
  fConnection := TFDConnection.Create(nil);
  try
    with fConnection do
    begin
      Params.Database := FileName;
      Params.DriverID := 'SQLite';
      Params.Password := Password;
      LoginPrompt := False;
      Connected := True;
      try
        ExecSQL('VACUUM');
      except
        nop;
      end;
    end;
  except
    if Password.IsEmpty then
      Application.MessageBox(PChar(Format('Невозможно открыть файл "%s". Возможно программа уже запущена.',
        [FileName])), 'Ошибка', MB_OK or MB_ICONERROR)
    else
      Application.MessageBox(PChar(Format('Файл конфигурации не предназначен для данного устройства.'#13#10
        + 'Удалите файл "%s" и повторите попытку.', [IniFileName])), 'Ошибка', MB_OK or
        MB_ICONERROR);
    Halt(0);
  end;
end;

destructor TSQLiteIni.Destroy;
begin
  with fConnection do
  begin
    if Connected then
    try
      ExecSQL('VACUUM');
    except
      nop;
    end;
    Connected := False;
  end;
  FreeAndNil(fConnection);
  inherited;
end;

function TSQLiteIni.Read(const Section, Variable: string; const DefaultValue: Variant):
  Variant;
begin
  Result := DefaultValue;
  with TFDQuery.Create(nil) do
  try
    Connection := fConnection;
    SQL.Text := Format('SELECT * FROM [sqlite_master] WHERE [name] = ''%s'' and [type] = ''table''',
      [Section]);
    Active := True;
    if RecordCount > 0 then
    begin
      Active := False;
      SQL.Text := Format('SELECT [Value] FROM [%s] WHERE [Variable] = ''%s''', [Section,
        Variable]);
      Active := True;
      if RecordCount > 0 then
      begin
        Result := FieldByName('Value').AsVariant;
      end;
    end;
  finally
    Free;
  end;
end;

procedure TSQLiteIni.Write(const Section, Variable: string; const Value: Variant);
begin
  with TFDQuery.Create(nil) do
  try
    Connection := fConnection;
    SQL.Text := Format('SELECT * FROM [sqlite_master] WHERE [name] =''%s'' and [type]=''table''',
      [Section]);
    Active := True;
    if RecordCount <= 0 then
    try
      fConnection.ExecSQL(Format('CREATE TABLE IF NOT EXISTS [%s]([Variable] TEXT PRIMARY KEY NOT NULL, [Value] TEXT);',
        [Section]));
    except
      nop;
    end;
    Active := False;
    SQL.Text := Format('SELECT [Value] FROM [%s] WHERE [Variable] =''%s''', [Section,
      Variable]);
    Active := True;
    if RecordCount > 0 then
    begin
      Active := False;
      SQL.Text := Format('UPDATE [%s] SET [Value] = ''%s'' WHERE [Variable] = ''%s''', [Section,
        Value, Variable]);
      ExecSQL;
    end
    else
    begin
      Active := False;
      SQL.Text := Format('INSERT INTO [%s]([Variable], [Value]) VALUES(''%s'', ''%s'')', [Section,
        Variable, Value]);
      ExecSQL;
    end;
  finally
    Free;
  end;
end;

end.