unit MEPDatabaseIO;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils
, sqldb
, fgl;
const
DefaultAliasesFileName: string = 'MEP-dbaliases.ini';
type
TConnectionParams = specialize TFPGMap<string, string>;
TQueriesMap = specialize TFPGMap<string, TSQLQuery>;
TMEPDatabaseIOStrings = specialize TFPGList<string>; // This is used to create sets of queries easily
{ TQueries }
TQueries = class(TObject)
public
Queries: TQueriesMap;
Transaction: TSQLTransaction;
constructor Create(); reintroduce;
destructor Destroy(); override;
end;
TMEPDatabaseType = (
dtUnknown
, dtSQLite
, dtPostgreSQL
);
{$REGION 'MEP Connection'}
type
{ TMEPConnection }
TMEPConnection = class(TObject)
private
fAliasesFilePath: string;
fAliasName: string;
fInMemory: Boolean;
fConnectionParameters: TConnectionParams;
fConnection: TSQLConnection;
_imposeSQLiteFilename : Boolean;
_imposedSQLiteFilename : string;
procedure InnerCreate(paliasesFilePath: string; paliasName: string);
procedure TryReloadAliasParameters();
procedure SetAliasesFilePath(value: string);
procedure SetAliasName(value: string);
procedure SetInMemory(value: Boolean);
function GetDatabaseType: TMEPDatabaseType;
public
property AliasesFilePath: string read fAliasesFilePath write SetAliasesFilePath;
property AliasName: string read fAliasName write SetAliasName;
property InMemory: Boolean read fInMemory write SetInMemory;
property DatabaseType: TMEPDatabaseType read GetDatabaseType;
constructor Create(); reintroduce; overload;
constructor Create(paliasName: string); reintroduce; overload;
constructor Create(paliasesFilePath: string; paliasName: string); reintroduce; overload;
destructor Destroy(); override;
procedure AssignSQLiteParameters(basePath: string; databaseName: string);
{procedure AssignPostgresqlParameters(????);}
procedure ReloadAliasParameters();
procedure ConnectionCreate();
procedure ConnectionOpen();
function TransactionCreate(): TSQLTransaction;
function QueryCreate(transaction: TSQLTransaction): TSQLQuery; overload;
function QueryCreate(sql: string; transaction: TSQLTransaction): TSQLQuery; overload;
procedure QueryCreate(var transaction: TSQLTransaction; var query: TSQLQuery); overload;
procedure QueryCreate(sql: string; var transaction: TSQLTransaction; var query: TSQLQuery); overload;
function QueriesCreate(transaction: TSQLTransaction): TQueries; overload;
{ using SysUtils.TStringArray explicitely because of a conflict with sqlite3conn.TStringArray }
function QueriesCreate(names: SysUtils.TStringArray; sqls: SysUtils.TStringArray; transaction: TSQLTransaction): TQueries; overload;
function QueriesCreate(names: TMEPDatabaseIOStrings; sqls: TMEPDatabaseIOStrings; transaction: TSQLTransaction): TQueries; overload;
procedure QueriesCreate(var transaction: TSQLTransaction; var queries: TQueries); overload;
procedure QueriesCreate(names: SysUtils.TStringArray; sqls: SysUtils.TStringArray; var transaction: TSQLTransaction; var queries: TQueries); overload;
procedure QueriesCreate(names: TMEPDatabaseIOStrings; sqls: TMEPDatabaseIOStrings; var transaction: TSQLTransaction; var queries: TQueries); overload;
function GetActualSQLiteFilename(): string;
procedure ImposeSQLiteFilename(filename: string);
function RunBackup(targetConnection: TMEPConnection; var ErrorMessage: string): Boolean;
procedure DeleteDatabase();
end;
{$ENDREGION}
implementation
uses
IniFiles
, db
, sqlite3conn
, sqlite3backup
, pqconnection
, streamex
, MEPWorkingPaths
;
{$REGION TQueries}
constructor TQueries.Create();
begin
inherited Create();
Queries := TQueriesMap.Create();
end;
destructor TQueries.Destroy();
var
i: Integer;
begin
for i := 0 to Queries.Count -1 do
begin
Queries.Data[i].Destroy();
end;
Queries.Destroy();
inherited Destroy();
end;
{$ENDREGION}
{ TMEPConnection }
const
SQLIteInMemoryDBAlias = ':memory:';
constructor TMEPConnection.Create();
begin
inherited Create();
InnerCreate(MEPWorkingPaths.DBPersistentDirectory + PathDelim + DefaultAliasesFileName, '');
// User has not supplied the alias name, it is not possible to load anything
end;
constructor TMEPConnection.Create(paliasName: string);
begin
inherited Create();
InnerCreate(MEPWorkingPaths.DBPersistentDirectory + PathDelim + DefaultAliasesFileName, paliasName);
// As user has explicitely indicated the alias name it must fail on error
ReloadAliasParameters();
end;
constructor TMEPConnection.Create(paliasesFilePath: string; paliasName: string);
begin
inherited Create();
InnerCreate(paliasesFilePath, paliasName);
// As user has explicitely indicated the alias name it must fail on error
ReloadAliasParameters();
end;
procedure TMEPConnection.InnerCreate(paliasesFilePath: string; paliasName: string);
begin
fAliasesFilePath := paliasesFilePath;
fAliasName := paliasName;
fInMemory := False;
fConnectionParameters := TConnectionParams.Create();
fConnection := nil;
_imposeSQLiteFilename := False;
_imposedSQLiteFilename := '';
end;
destructor TMEPConnection.Destroy();
begin
FreeAndNil(fConnectionParameters);
FreeAndNil(fConnection);
inherited Destroy();
end;
procedure TMEPConnection.SetAliasesFilePath(value: string);
begin
fAliasesFilePath := value;
// It might be not all necessary params are set
TryReloadAliasParameters();
end;
procedure TMEPConnection.SetAliasName(value: string);
begin
fAliasName := value;
// It might be not all necessary params are set
TryReloadAliasParameters();
end;
procedure TMEPConnection.SetInMemory(value: Boolean);
begin
fInMemory := value;
// It might be not all necessary params are set
TryReloadAliasParameters();
end;
procedure TMEPConnection.AssignSQLiteParameters(basePath: string; databaseName: string);
begin
if (fInMemory) then
begin
fConnectionParameters.Clear();
fConnectionParameters.Add('DatabaseType', 'sqlite');
// In memory db
Exit();
end;
fConnectionParameters.Clear();
fConnectionParameters.Add('BasePath' , basePath );
fConnectionParameters.Add('DatabaseName', databaseName);
end;
procedure TMEPConnection.ReloadAliasParameters();
var
aliasesIni: TIniFile;
aliasIniLines: TStringList;
stringarray: TStringArray;
i: Integer;
begin
if (fInMemory) then
begin
fConnectionParameters.Clear();
fConnectionParameters.Add('DatabaseType', 'sqlite');
// In memory db
Exit();
end;
fConnectionParameters.Clear();
aliasesIni := TIniFile.Create(fAliasesFilePath);
aliasIniLines := TStringList.Create();
try
if aliasesIni.SectionExists(fAliasName) then
begin
try
aliasesIni.ReadSectionValues(fAliasName, aliasIniLines);
for i := 0 to aliasIniLines.Count - 1 do begin
stringarray := aliasIniLines[i].Split('=');
try
fConnectionParameters.Add(stringarray[0], stringarray[1]);
finally
stringarray := nil;
end;
end;
except
on E: Exception do begin
raise Exception.Create(
Format('Unexpected error while reading alises file in "%s" (Message: "%s")',
[fAliasesFilePath, E.Message]));
end;
end;
end;
finally
FreeAndNil(aliasIniLines);
FreeAndNil(aliasesIni);
end;
end;
procedure TMEPConnection.TryReloadAliasParameters();
begin
try
ReloadAliasParameters();
except
// It is allowed to fail silently
end;
end;
function TMEPConnection.GetDatabaseType: TMEPDatabaseType;
begin
case fConnectionParameters['DatabaseType'] of
'sqlite' :
begin
Result := TMEPDatabaseType.dtSQLite;
end;
'postgresql':
begin
Result := TMEPDatabaseType.dtPostgreSQL;
end;
else
begin
Result := TMEPDatabaseType.dtUnknown;
end;
end;
end;
procedure TMEPConnection.ConnectionCreate();
function GetSQLConnection(): TSQLConnection;
function GetSQLConnection_SQLite(): TSQLConnection;
const
sqlite_time_dynamic_indicator: string = '<time-dynamic>';
var
BasePath: string;
DatabaseName: string;
begin
if (fInMemory) then
begin
Result := TSQLite3Connection.Create(nil);
Result.DatabaseName := SQLIteInMemoryDBAlias;
Exit();
end;
if (fConnectionParameters.IndexOf('BasePath') = -1) then begin
BasePath := '.';
end else
begin
BasePath := fConnectionParameters['BasePath'];
end;
if (fConnectionParameters.IndexOf('DatabaseName') = -1) then begin
DatabaseName := 'db_sqlite';
end else
begin
DatabaseName := fConnectionParameters['DatabaseName'];
if (DatabaseName.Contains(sqlite_time_dynamic_indicator)) then
begin
DatabaseName := DatabaseName.Replace(sqlite_time_dynamic_indicator, FormatDateTime('YYYYMMDDHHmmss', SysUtils.Now()));
end;
end;
Result := TSQLite3Connection.Create(nil);
if (_imposeSQLiteFilename) then
begin
Result.DatabaseName := _imposedSQLiteFilename;
end
else begin
Result.DatabaseName := BasePath + PathDelim + DatabaseName;
end;
end;
function GetSQLConnection_PostgreqSQL(): TSQLConnection;
var
Hostname: string;
Port: string;
DatabaseName: string;
DatabaseUsername: string;
DatabasePassword: string;
begin
if (fConnectionParameters.IndexOf('Hostname') = -1) then begin Hostname := 'locahost'; end else begin Hostname := fConnectionParameters['Hostname' ]; end;
if (fConnectionParameters.IndexOf('Port') = -1) then begin Port := '5432'; end else begin Port := fConnectionParameters['Port' ]; end;
if (fConnectionParameters.IndexOf('DatabaseName') = -1) then begin DatabaseName := 'pg_db'; end else begin DatabaseName := fConnectionParameters['DatabaseName' ]; end;
if (fConnectionParameters.IndexOf('DatabaseUsername') = -1) then begin DatabaseUsername := 'pg_user'; end else begin DatabaseUsername := fConnectionParameters['DatabaseUsername' ]; end;
if (fConnectionParameters.IndexOf('DatabasePassword') = -1) then begin DatabasePassword := 'pg_password'; end else begin DatabasePassword := fConnectionParameters['DatabasePassword' ]; end;
Result := TPQConnection.Create(nil);
Result.HostName := Hostname;
Result.Params.Add(Format('port=%d', [Port]));
Result.DatabaseName := DatabaseName;
Result.UserName := DatabaseUsername;
Result.Password := DatabasePassword;
end;
begin
if (fConnectionParameters.IndexOf('DatabaseType') = -1) then begin
raise Exception.Create(Format('Parameter "DatabaseType" not found in "%s" for alias "%s"', [fAliasesFilePath, fAliasName]));
end else
begin
case fConnectionParameters['DatabaseType'] of
'sqlite' : begin Result := GetSQLConnection_SQLite (); end;
'postgresql': begin Result := GetSQLConnection_PostgreqSQL(); end;
else raise Exception.Create(Format('Parameter "DatabaseType" value "%s" is not known in "%s" for alias "%s"', [fConnectionParameters['DatabaseType'], fAliasesFilePath, fAliasName]));
end;
end;
end;
begin
fConnection := GetSQLConnection();
end;
procedure TMEPConnection.ConnectionOpen();
var
transaction: TSQLTransaction;
q: TSQLQuery;
begin
ConnectionCreate();
fConnection.Connected := True;
transaction := TransactionCreate();
try
transaction.StartTransaction();
try
q := QueryCreate('PRAGMA foreign_keys = ON', transaction);
try
q.ExecSQL();
finally
FreeAndNil(q);
end;
transaction.Commit();
except
transaction.Rollback();
end;
finally
FreeAndNil(transaction);
end;
end;
function TMEPConnection.TransactionCreate(): TSQLTransaction;
begin
Result := TSQLTransaction.Create(nil);
Result.Options:=[stoExplicitStart];
Result.DataBase := fConnection;
end;
function TMEPConnection.QueryCreate(transaction: TSQLTransaction): TSQLQuery;
begin
Result := TSQLQuery.Create(nil);
Result.Transaction := transaction;
end;
function TMEPConnection.QueryCreate(sql: string; transaction: TSQLTransaction): TSQLQuery;
begin
Result := QueryCreate(transaction);
Result.SQL.Add(sql);
end;
procedure TMEPConnection.QueryCreate(var transaction: TSQLTransaction; var query: TSQLQuery);
begin
transaction := TransactionCreate();
query := QueryCreate(transaction);
end;
procedure TMEPConnection.QueryCreate(sql:string; var transaction: TSQLTransaction; var query: TSQLQuery);
begin
QueryCreate(transaction, query);
query.SQL.Add(sql);
end;
function TMEPConnection.QueriesCreate(transaction: TSQLTransaction): TQueries;
begin
Result := TQueries.Create();
Result.Transaction := transaction;
end;
function TMEPConnection.QueriesCreate(names: SysUtils.TStringArray; sqls: SysUtils.TStringArray; transaction: TSQLTransaction): TQueries;
var
i: Integer;
begin
Result := QueriesCreate(transaction);
for i := 0 to Length(names) - 1 do
begin
Result.Queries.Add(names[i], QueryCreate(sqls[i], Result.Transaction));
end;
end;
function TMEPConnection.QueriesCreate(names: TMEPDatabaseIOStrings; sqls: TMEPDatabaseIOStrings; transaction: TSQLTransaction): TQueries;
var
i: Integer;
begin
Result := QueriesCreate(transaction);
for i := 0 to names.Count - 1 do
begin
Result.Queries.Add(names[i], QueryCreate(sqls[i], Result.Transaction));
end;
end;
procedure TMEPConnection.QueriesCreate(var transaction: TSQLTransaction; var queries: TQueries);
begin
transaction := TransactionCreate();
queries := QueriesCreate(transaction);
end;
procedure TMEPConnection.QueriesCreate(names: SysUtils.TStringArray; sqls: SysUtils.TStringArray; var transaction: TSQLTransaction; var queries: TQueries);
begin
transaction := TransactionCreate();
QueriesCreate(names, sqls, transaction, queries);
end;
procedure TMEPConnection.QueriesCreate(names: TMEPDatabaseIOStrings; sqls: TMEPDatabaseIOStrings; var transaction: TSQLTransaction; var queries: TQueries);
begin
transaction := TransactionCreate();
QueriesCreate(names, sqls, transaction, queries);
end;
function TMEPConnection.GetActualSQLiteFilename(): string;
begin
if (fConnection is TSQLite3Connection) then
begin
Result := TSQLite3Connection(fConnection).DatabaseName;
end
else begin
Result := '';
end;
end;
procedure TMEPConnection.ImposeSQLiteFilename(filename: string);
begin
_imposeSQLiteFilename := True;
_imposedSQLiteFilename := filename;
end;
function TMEPConnection.RunBackup(targetConnection: TMEPConnection; var ErrorMessage: string): Boolean;
var
backup: TSQLite3Backup;
begin
backup := TSQLite3Backup.Create();
try
if (not backup.Backup(TSQLite3Connection(fConnection), TSQLite3Connection(targetConnection.fConnection), {LockUntilFinished}True)) then begin
ErrorMessage := backup.ErrorMessage;
Result := False;
end
else begin
Result := True;
end;
finally
FreeAndNil(backup);
end;
end;
procedure TMEPConnection.DeleteDatabase();
var
fileHandle: File;
begin
if (fConnection = nil) then
begin
raise Exception.Create('Cannot delete a database without a connection');
end;
if (fConnection.Connected) then
begin
raise Exception.Create('Cannot delete a database while a connection is opened');
end;
System.Assign(fileHandle, fConnection.DatabaseName);
System.Erase(fileHandle);
end;
{
Usage:
var
connection: TMEPConnection;
transation: TSQLTransation;
queries: TQueries;
begin
conn := TMEPConnection.Create(); // or Create('dbalias1'); or Create('fullpath to db-aliases file', 'dbalias1');
conn.AliasName := 'myalias'; //unless it was set on creation with dedicated methods
try
transation := conn.TransactionCreate();
queries := conn.QueriesCreate(['q1', 'q2'], ['select * from table1', 'select * from table2'], transaction);
try
transaction.StartTransation();
try
queries['q1'].Open();
queries['q2'].Open();
queries['q1'].Close();
queries['q2'].Close();
transaction.Commit();
except
transaction.Rollback();
end;
finally
FreeAndNil(transation);
end;
finally
FreeAndNil(conn);
end;
end;
}
end.