Support for MSSQL with ZEOS library

[SergioIsBack]

Hi Ali,

I Have an experimental modified version of your EasyDB.ConnectionManager.SQL and EasyDB.Core for support ZeosLibrary connector in case of using your library with MSSQL and Delphi Professional version (with no MSSQL and Oracle drivers provided)

It will juste require a ZEOSLIB define in the projet options (and ZeosLib components installed too !!)
It can use ado or mssql direct driver also

Tested with SQLServer and your SimpleSQL Server sample, it's working

See modified units bellow

{}
{ }
{ Auhtor: Ali Dehbansiahkarbon([email protected]) }
{ GitHub: https://github.com/AliDehbansiahkarbon }
{ }
{}
unit EasyDB.ConnectionManager.SQL;

interface

uses
System.SysUtils, System.Classes, System.StrUtils, {$IF CompilerVersion >= 27}System.Threading, {$IFEND}
{$IFDEF ZEOSLIB}
ZAbstractConnection, ZConnection, Data.DB, ZAbstractRODataset,
ZAbstractDataset, ZDataset, ZDbcIntfs,
{$ELSE}
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf,
FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.VCLUI.Wait,
Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt,
FireDAC.Comp.DataSet,
{==MSSQL==} {$IF CompilerVersion >= 30}FireDAC.Phys.MSSQLDef, {$IFEND} FireDAC.Phys.ODBCBase, FireDAC.Phys.MSSQL,{==MSSQL==}
{$ENDIF}

EasyDB.ConnectionManager.Base,
EasyDB.Core,
EasyDB.Logger,
EasyDB.Consts,
EasyDB.Runner;

type

TSQLConnection = class(TConnection) // Singletone
private
{$IFDEF ZEOSLIB}
FConnection : TZConnection;
FQuery : TZQuery;
{$ELSE}
FConnection: TFDConnection;
FMSSQLDriver: TFDPhysMSSQLDriverLink;
FQuery: TFDQuery;
{$ENDIF}
FConnectionParams: TSqlConnectionParams;
FParentRunner: TRunner;
Constructor Create;
class var FInstance: TSQLConnection;
public
class function Instance: TSQLConnection;
Destructor Destroy; override;

function GetConnectionString: string; override;
function SetConnectionParam(AConnectionParams: TSqlConnectionParams): TSQLConnection;
function Connect: Boolean; override;
function ConnectEx: TSQLConnection;
function IsConnected: Boolean;
function InitializeDatabase: Boolean;
function Logger: TLogger; override;
function RemoveCommentFromTSQL(const ASQLLine: string): string;
function OpenAsInteger(AScript: string): Largeint;

procedure ExecuteAdHocQuery(AScript: string); override;
procedure ExecuteAdHocQueryWithTransaction(AScript: string);
procedure ExecuteScriptFile(AScriptPath: string; ADelimiter: string); override;
procedure BeginTrans;
procedure CommitTrans;
procedure RollBackTrans;

property ConnectionParams: TSqlConnectionParams read FConnectionParams;
property ParentRunner: TRunner read FParentRunner write FParentRunner;

end;

implementation

{ TSQLConnection }

function TSQLConnection.ConnectEx: TSQLConnection;
begin
if Connect then
Result := FInstance
else
begin
Self.Free;
Result := nil;
end;
end;

constructor TSQLConnection.Create;
begin
{$IFDEF ZEOSLIB}
FConnection:=TZConnection.Create(nil);
FConnection.Protocol:='Ado';
FConnection.TransactIsolationLevel:=TZTransactIsolationLevel.tiReadCommitted;

FQuery := TZQuery.Create(nil);
FQuery.Connection := FConnection;

{$ELSE}
FConnection := TFDConnection.Create(nil);
FMSSQLDriver := TFDPhysMSSQLDriverLink.Create(nil);

FConnection.DriverName := 'MSSQL';
FConnection.LoginPrompt := False;

FQuery := TFDQuery.Create(nil);
FQuery.Connection := FConnection;

{$ENDIF}
FParentRunner := nil;

end;

destructor TSQLConnection.Destroy;
begin
FQuery.Close;
FQuery.Free;
{$IFDEF ZEOSLIB}
FConnection.Disconnect;
{$ELSE}
FConnection.Close;
FMSSQLDriver.Free;
{$ENDIF}
FConnection.Free;

FInstance := nil;
inherited;

end;

procedure TSQLConnection.BeginTrans;
begin
{$IFDEF ZEOSLIB}
FConnection.StartTransaction;
{$ELSE}
FConnection.Transaction.StartTransaction;
{$ENDIF}
end;

function TSQLConnection.Connect: Boolean;
begin
try
FConnection.Connected := True;
if not FConnectionParams.DatabaseName.ToLower.Trim.Equals('master') then
InitializeDatabase;

Result := True;

except on E: Exception do
begin
Logger.Log(atDbConnection, E.Message);
Result := False;
end;
end;
end;

procedure TSQLConnection.CommitTrans;
begin
{$IFDEF ZEOSLIB}
FConnection.Commit;
{$ELSE}
FConnection.Transaction.Commit;
{$ENDIF}
end;

procedure TSQLConnection.ExecuteAdHocQuery(AScript: string);
begin
try
{$IFDEF ZEOSLIB}
FQuery.SQL.Text:=AScript;
FQuery.ExecSQL;
{$ELSE}
FConnection.ExecSQL(AScript);
{$ENDIF}
except on E: Exception do
begin
E.Message := ' Script: ' + AScript + #13#10 + ' Error: ' + E.Message;
raise;
end;
end;
end;

procedure TSQLConnection.ExecuteAdHocQueryWithTransaction(AScript: string);
begin
try
BeginTrans;
{$IFDEF ZEOSLIB}
FQuery.SQL.Text:=AScript;
FQuery.ExecSQL;
{$ELSE}
FConnection.ExecSQL(AScript);
{$ENDIF}
CommitTrans;
except on E: Exception do
begin
RollBackTrans;
E.Message := ' Script: ' + AScript + #13#10 + ' Error: ' + E.Message;
raise;
end;
end;
end;

procedure TSQLConnection.ExecuteScriptFile(AScriptPath: string; ADelimiter: string);
var
LvStreamReader: TStreamReader;
LvLine: string;
LvStatement: string;
LvLineNumber: Integer;
{$IF CompilerVersion >= 30}
LvTask: ITask;
{$ELSE}
LvThread: TThread;
{$ENDIF}
LvLogExecutions: Boolean;
begin
if Assigned(FParentRunner) and Assigned(FParentRunner.Config) then
LvLogExecutions := FParentRunner.Config.LogAllExecutionsStat
else
LvLogExecutions := False;

if FileExists(AScriptPath) then
begin
{$IF CompilerVersion >= 30}
LvTask := TTask.Run(
{$ELSE}
LvThread := TThread.CreateAnonymousThread(
{$ENDIF}
procedure
begin
LvLineNumber := 1;
LvStreamReader := TStreamReader.Create(AScriptPath, TEncoding.UTF8);
LvLine := EmptyStr;
LvStatement := EmptyStr;
try
while not LvStreamReader.EndOfStream do
begin
LvLine := LvStreamReader.ReadLine;
if not LvLine.Trim.ToLower.Equals(ADelimiter.Trim.ToLower) then
begin
if not ((LeftStr(LvLine.Trim, 2) = '/') or (RightStr(LvLine.Trim, 2) = '/') or (LeftStr(LvLine.Trim, 2) = '--')) then
LvStatement := LvStatement + ' ' + RemoveCommentFromTSQL(LvLine)
end
else
begin
if not LvStatement.Trim.IsEmpty then
begin
try
try
if LvLogExecutions then
Logger.Log(atFileExecution, 'Line: ' + LvLineNumber.ToString + ' successfully executed');

              ExecuteAdHocQuery(LvStatement);
            except on E: Exception  do
              Logger.Log(atFileExecution, 'Error on Line: ' + LvLineNumber.ToString + #13 + E.Message);
            end;
          finally
            LvStatement := EmptyStr;
          end;
        end;
      end;
      Inc(LvLineNumber);
    end;
    Logger.Log(atFileExecution, 'Done!');
  finally
    LvStreamReader.Free;
  end;
end);
{$IF CompilerVersion < 30}
LvThread.FreeOnTerminate := True;
LvThread.Start;
{$ENDIF}

end
else
Logger.Log(atFileExecution, 'Script file doesn''t exists.');
end;

function TSQLConnection.RemoveCommentFromTSQL(const ASQLLine: string): string;
var
LvCommentIndex: Integer;
begin
LvCommentIndex := Pos('--', ASQLLine);
if LvCommentIndex > 0 then
Result := Trim(Copy(ASQLLine, 1, LvCommentIndex - 1))
else
Result := ASQLLine;
end;

function TSQLConnection.GetConnectionString: string;
begin
{$IFDEF ZEOSLIB}
Result := FConnection.Database;
{$ELSE}
Result := FConnection.ConnectionString;
{$ENDIF}
end;

function TSQLConnection.InitializeDatabase: Boolean;
var
LvTbScript: string;
begin
LvTbScript := 'If Not Exists ( ' + #10
+ ' Select * ' + #10
+ ' From sysobjects ' + #10
+ ' Where Name = ' + TB.QuotedString + ' ' + #10
+ ' And xtype = ''U'' ' + #10
+ ' ) ' + #10
+ ' Create Table ' + TB + ' ' + #10
+ ' ( ' + #10
+ ' Version Bigint Not null Primary Key, ' + #10
+ ' AppliedOn Datetime Default(Getdate()), ' + #10
+ ' Author Nvarchar(100), ' + #10
+ ' Description Nvarchar(Max) ' + #10
+ ' ' + #10
+ ' )';

try
ExecuteAdHocQuery(LvTbScript);
Result := True;
except on E: Exception do
begin
Logger.Log(atInitialize, E.Message);
Result := False;
end;
end;
end;

class function TSQLConnection.Instance: TSQLConnection;
begin
if not Assigned(FInstance) then
FInstance := TSQLConnection.Create;

Result := FInstance;
end;

function TSQLConnection.IsConnected: Boolean;
begin
Result := FConnection.Connected;
end;

function TSQLConnection.Logger: TLogger;
begin
Result := TLogger.Instance;
end;

function TSQLConnection.OpenAsInteger(AScript: string): Largeint;
begin
{$IFDEF ZEOSLIB}
FQuery.SQL.Text:=AScript;
FQuery.Open;
{$ELSE}
FQuery.Open(AScript);
{$ENDIF}
if FQuery.RecordCount > 0 then
Result := FQuery.Fields[0].AsLargeInt
else
Result := -1;
end;

procedure TSQLConnection.RollBackTrans;
begin
{$IFDEF ZEOSLIB}
FConnection.Rollback;
{$ELSE}
FConnection.Transaction.Rollback;
{$ENDIF}
end;

function TSQLConnection.SetConnectionParam(AConnectionParams: TSqlConnectionParams): TSQLConnection;
begin
FConnectionParams := AConnectionParams;
{$IFDEF ZEOSLIB}
FConnectionParams.Protocol:=FConnectionParams.Protocol.ToLower;
if FConnectionParams.Protocol='ado' then
begin
if FConnectionParams.UserName.IsEmpty and FConnection.Password.IsEmpty then
begin
FConnection.Database:=Format('Provider=%s;Server=tcp:%s;Database=%s;Integrated Security=SSPI;Persist Security Info=True',
[FConnectionParams.Provider,FConnectionParams.Server,FConnectionParams.DatabaseName]);
end
else
begin
FConnection.Database:=Format('Provider=%s;Server=tcp:%s;Database=%s;User Id=%s;Password=%s;Persist Security Info=True',
[FConnectionParams.Provider,FConnectionParams.Server,FConnectionParams.DatabaseName,FConnectionParams.UserName,FConnectionParams.Pass]);
end;
end
else
begin
if FConnectionParams.Port=0 then FConnectionParams.Port:=1433;
FConnection.Protocol:=FConnectionParams.Protocol;
FConnection.Database:=FConnectionParams.DatabaseName;
FConnection.Catalog:=FConnectionParams.Schema;
FConnection.Port:=FConnectionParams.Port;
FConnection.User:=FConnectionParams.UserName;
FConnection.Password:=FConnectionParams.Pass;
end;
{$ELSE}
with FConnection.Params, FConnectionParams do
begin
Add('Server=' + Server);
Add('User_Name=' + UserName);
Add('Password=' + Pass);
Add('DriverID=MSSQL');
Add('LoginTimeout=' + LoginTimeout.ToString);
Add('Database=' + DatabaseName);
end;
{$ENDIF}
Result := FInstance;
end;
end.

{}
{ }
{ Auhtor: Ali Dehbansiahkarbon([email protected]) }
{ GitHub: https://github.com/AliDehbansiahkarbon }
{ }
{}
unit EasyDB.Core;

interface
uses
Vcl.ComCtrls, System.Generics.Collections;

type
TMigrationBase = class;
TArrangeMode = (umASC, umDESC);
TMigrations = TObjectList;
TMigrationsDic = TObjectDictionary<Int64, TMigrations>;

TActionTypes = (atUpgrade, atDownGrade, atInitialize, atPreparingMigrations,
atDbConnection, atQueryExecution, atFileExecution, atCallBackEvent);

TSqlConnectionParams = record
Server: string;
LoginTimeout: Integer;
UserName: string;
Pass: string;
DatabaseName: string;
Schema: string;
{$IFDEF ZEOSLIB}
Protocol : string;
Provider : string;
Port : Integer;
{$ENDIF}
end;

TMySqlConnectionParams = record
Server: string;
LoginTimeout: Integer;
Port: Integer;
UserName: string;
Pass: string;
Schema: string;
end;

TMariaDBConnectionParams = record
Server: string;
LoginTimeout: Integer;
Port: Integer;
UserName: string;
Pass: string;
Schema: string;
end;

TPgConnectionParams = record
Server: string;
LoginTimeout: Integer;
Port: Integer;
UserName: string;
Pass: string;
DatabaseName: string;
Schema: string;
end;

TOracleConnectionParams = record
Server: string;
LoginTimeout: Integer;
Port: Integer;
UserName: string;
Pass: string;
DatabaseName: string;
end;

TFirebirdConnectionParams = record
Host: string;
Database: string;
UserName: string;
Pass: string;
end;

IRunner = interface
['{DECF074C-109F-488F-A97D-4B3C68FB4F35}']

procedure UpdateVersionInfo(AMigration: TMigrationBase; AInsertMode: Boolean = True);
procedure DownGradeVersionInfo(AVersionToDownGrade: Int64);
function GetDatabaseVersion: Int64;

end;

TMigrationBase = class
public
HiddenAttribDic: TDictionary<string, Variant>;
HasAttribDic: Boolean;
procedure CreateHiddenAttribDic(AEntityName: string; AVersion: int64; AAuthor: string; ADescription: string);
destructor Destroy; override;
end;

TConfig = class
private
FLogAllExecutions: Boolean;
FUseInternalThread: Boolean;
FProgressBar: TProgressBar;
FDelay: Cardinal;
///
/// Must be in Percentage.
///
FProgressSteps: Integer;
public
constructor Create;
function LogAllExecutions(AValue: Boolean): TConfig;
function UseInternalThread(AValue: Boolean): TConfig;
function SetProgressbar(AProgressbar: TProgressBar; AProgressStep: Integer = 1): TConfig;
function DelayedExecution(ADelay: Cardinal): TConfig;

property ProgressBar: TProgressBar read FProgressBar;
property UseThreadStat: Boolean read FUseInternalThread;
property LogAllExecutionsStat: Boolean read FLogAllExecutions;
property Delay: Cardinal read FDelay;
property ProgressSteps: Integer read FProgressSteps write FProgressSteps;

end;

implementation
{ TMigrationBase }

uses
EasyDB.Migration, EasyDB.MigrationX;

procedure TMigrationBase.CreateHiddenAttribDic(AEntityName: string; AVersion: int64; AAuthor: string; ADescription: string);
begin
HiddenAttribDic := TDictionary<string, Variant>.Create;
HiddenAttribDic.Add('EntityName', AEntityName);
HiddenAttribDic.Add('Version', AVersion);
HiddenAttribDic.Add('Author', AAuthor);
HiddenAttribDic.Add('Description', ADescription);
end;

destructor TMigrationBase.Destroy;
begin
if Assigned(HiddenAttribDic) then
HiddenAttribDic.Free;
inherited;
end;

{ TConfig }

constructor TConfig.Create;
begin
FUseInternalThread := False;
FLogAllExecutions := False;
FProgressBar := nil;
FDelay := 0;
end;

function TConfig.DelayedExecution(ADelay: Cardinal): TConfig;
begin
FDelay := ADelay;
Result := Self;
end;

function TConfig.LogAllExecutions(AValue: Boolean): TConfig;
begin
FLogAllExecutions := AValue;
Result := Self;
end;

function TConfig.SetProgressbar(AProgressbar: TProgressBar; AProgressStep: Integer): TConfig;
begin
FProgressBar := AProgressbar;
FProgressSteps := AProgressStep;
Result := Self;
end;

function TConfig.UseInternalThread(AValue: Boolean): TConfig;
begin
FUseInternalThread := AValue;
Result := Self;
end;

end.

[AliDehbansiahkarbon]

Hi,
Thank you for your advice.
Actually, I would like to make some changes in this regard but more database components like (SDAC, UniDAC, ADO, and etc) are in my mind all the time to be supported somehow to make it suitable for more developers and more projects.

If I add a lot of directives then probably after a while, the core units of the library may end up with some complicated and messy code.

I'm thinking about a better solution by adding an upper interface layer in the connection manager section to pass something like IConnection instead of TConnection and so on.
I just need time to make the necessary changes, for now, please update your fork on GitHub and use it in your way, I'll inform you and others at the end with a new release, I guarantee that you will be able to use the next version with minimum changes in your project,