unit uDASQLitePassDriver;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Driver Library                                     }
{                                                                            }
{ compiler: Delphi 6 and up, Kylix 3 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the Data Abstract              }
{ which can be obtained at http://www.remobjects.com.                        }
{                                                                            }
{ based on code of Giovanni Siano                                            }
{----------------------------------------------------------------------------}

{$IFDEF MSWINDOWS}
{$I ..\DataAbstract.inc}
{$ELSE}
{$I ../DataAbstract.inc}
{$ENDIF}

{$IFNDEF FPC}
{$R DataAbstract_SQLitePassDriver_Glyphs.res}
{$ENDIF}

interface

uses
  {$IFDEF MSWINDOWS}Windows,{$ENDIF}
  Classes, DB, uDAEngine, uDAInterfaces, uROClasses, uDAUtils, uDASQLiteInterfaces, SqlitePassDbo;

type
  { TDASQLitePassDriver }
  TDASQLitePassDriver = class(TDADriverReference)
  end;

  { TDAESQLiteDriver }
  TDAESQLiteDriver = class(uDASQLiteInterfaces.TDASQLiteDriver, IDADriver40)
  protected
    function GetConnectionClass: TDAEConnectionClass; override;
    procedure CustomizeConnectionObject(aConnection: TDAEConnection); override;
    // IDADriver
    function GetDriverID: string; override;
    function GetDescription: string; override;
    procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
  public
  end;

  // for access to protected methods
  TDASQLite3PassDB = class(TSqlitePassDatabase)
  private
  public
  end;

  { TSQLiteConnection }
  TSQLiteConnection = class(TDAConnectionWrapper)
  private
    fConnection: TDASQLite3PassDB;
  protected
    function GetConnected: Boolean; override;
    procedure SetConnected(Value: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Connection: TDASQLite3PassDB read fConnection;
  end;

  { TDAESQLiteConnection }
  TDAESQLiteConnection = class(TDASQLiteConnection)
  private
    FtransactionFlag: Boolean;
    fConnection: TSQLiteConnection;
  protected
    procedure SetConnected(Value: boolean); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    // TDAEConnection
    function CreateCustomConnection: TCustomConnection; override;
    function GetDatasetClass: TDAEDatasetClass; override;
    procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection); override;
    function DoBeginTransaction: integer; override;
    procedure DoCommitTransaction; override;
    procedure DoRollbackTransaction; override;
    function DoGetInTransaction: boolean; override;
    function DoGetLastAutoInc(const GeneratorName: string): integer; override;
    procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); override;
    procedure DoGetTableNames(out List: IROStrings); override;
  public
    constructor Create(aDriver: TDAEDriver; aName: string = ''); override;
  end;

  { TDAESQLiteQuery }
  TDAESQLiteQuery = class(TDAEDataset,IDAMustSetParams)
  private
  protected
    procedure ClearParams; override;
    function CreateDataset(aConnection: TDAEConnection): TDataset; override;
    procedure DoPrepare(Value: boolean); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function DoExecute: integer; override;
    function DoGetSQL: string; override;
    procedure DoSetSQL(const Value: string); override;
    procedure SetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
  end;

procedure Register;

function GetDriverObject: IDADriver; stdcall;

implementation

uses SysUtils, uDADriverManager, uDARes, Variants, TypInfo,
  uROBinaryHelpers, uDASQL92Interfaces, SqlitePassApi_v3, SqlitePassErrorLang;

var
  _driver: TDAEDriver = nil;

procedure Register;
begin
  RegisterComponents(DAPalettePageName, [TDASQLitePassDriver]);
end;

{$IFDEF DataAbstract_SchemaModelerOnly}
{$INCLUDE ..\DataAbstract_SchemaModelerOnly.inc}
{$ENDIF DataAbstract_SchemaModelerOnly}

function GetDriverObject: IDADriver;
begin
  if (_driver = nil) then _driver := TDAESQLiteDriver.Create(nil);
  result := _driver;
end;

{ TSQLiteConnection }

constructor TSQLiteConnection.Create(AOwner: TComponent);
begin
  inherited;
  fConnection := TDASQLite3PassDB.Create(nil);
end;

destructor TSQLiteConnection.Destroy;
begin
  inherited;
  fConnection.Free;
end;

function TSQLiteConnection.GetConnected: Boolean;
begin
  result := fConnection.Connected;
end;

procedure TSQLiteConnection.SetConnected(Value: Boolean);
begin
  fConnection.Connected := Value;
end;

{ TDAESQLiteConnection }

procedure TDAESQLiteConnection.DoApplyConnectionString(
  aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
var
  sName, sValue: string;
  i: integer;
begin
  inherited;
  with aConnStrParser do begin
    for i := 0 to (AuxParamsCount - 1) do begin
      sName := AuxParamNames[i];
      sValue := AuxParams[sName];
      if AnsiSameText(sName, 'SqliteLibrary') then begin
        fConnection.fConnection.SQLiteLibrary := sValue;
      end
      else if AnsiSameText(sName, 'DatabaseType') then begin
        if AnsiSameText(sValue, 'dbtSqlitePass') then fConnection.fConnection.DatabaseType := dbtSqlitePass
        else if AnsiSameText(sValue, 'dbtKexi') then fConnection.fConnection.DatabaseType := dbtKexi
        else if AnsiSameText(sValue, 'dbtSqliteAdmin') then fConnection.fConnection.DatabaseType := dbtSqliteAdmin
        else if AnsiSameText(sValue, 'dbtSqlite4Fpc') then fConnection.fConnection.DatabaseType := dbtSqlite4Fpc
        else if AnsiSameText(sValue, 'dbtSqliteExpert') then fConnection.fConnection.DatabaseType := dbtSqliteExpert
        else fConnection.fConnection.DatabaseType := dbtUnknown;
      end
      else if Pos('datatypeoptions.', AnsiLowerCase(sName)) = 1 then begin
        sName := Copy(sName,17, Length(sName)-16);
        SetPropValue(fConnection.fConnection.DatatypeOptions, sName, sValue);
      end
      else if Pos('options.', AnsiLowerCase(sName)) = 1 then begin
        sName := Copy(sName,9, Length(sName)-8);
        SetPropValue(fConnection.fConnection.Options, sName, sValue);
      end;
    end;
    TSQLiteConnection(aConnectionObject).Connection.Database := Database;
  end;
end;

function TDAESQLiteConnection.DoBeginTransaction: integer;
begin
  result := -1;
  fConnection.Connection.Engine.Transaction.Start;
  FtransactionFlag := True;
end;

procedure TDAESQLiteConnection.DoCommitTransaction;
begin
  fConnection.Connection.Engine.Transaction.Commit;
  FtransactionFlag := False;
end;

function TDAESQLiteConnection.CreateCustomConnection: TCustomConnection;
begin
  fConnection := TSQLiteConnection.Create(nil);
  result := fConnection;
end;

function TDAESQLiteConnection.GetDatasetClass: TDAEDatasetClass;
begin
  result := TDAESQLiteQuery;
end;

procedure TDAESQLiteConnection.DoRollbackTransaction;
begin
  FtransactionFlag := False;
  fConnection.Connection.Engine.Transaction.Rollback;
end;

function TDAESQLiteConnection.DoGetInTransaction: boolean;
begin
  Result := FtransactionFlag;
end;

procedure TDAESQLiteConnection.DoGetTableFields(const aTableName: string;
  out Fields: TDAFieldCollection);
var
  i: integer;
  fld: TDAField;
  lSqlitePassTableDef: TSqlitePassTableDef;
begin
  inherited DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), Fields);

  lSqlitePassTableDef :=  fConnection.Connection.TableDefs.TableByName(aTableName);

  with lSqlitePassTableDef do begin
    for i := 0 to Pred(Fields.Count - 1) do
    with FieldDefs.FindFieldDef(Fields[i].Name) do
    begin
      fld := Fields[i];
      fld.Required :=  NotNull;
      fld.InPrimaryKey := PrimaryKey;
      if fld.InPrimaryKey then fld.Required := True;
      fld.DefaultValue := DefaultValue;
    end;
  end;
end;

procedure TDAESQLiteConnection.SetConnected(Value: boolean);
var
  lErrorCode: integer;
  lMsg: String;
  lDateTime: TDateTime;
begin
  inherited;
  if not fConnection.fConnection.Connected then begin
    fConnection.fConnection.DatabaseError.GetLastError(lErrorCode,lMsg, lDateTime);
    if lMsg <> Msg1002 then raise Exception.Create(lMsg);
  end;
end;

constructor TDAESQLiteConnection.Create(aDriver: TDAEDriver;
  aName: string);
begin
  inherited;
  FtransactionFlag := False;
end;

function TDAESQLiteConnection.DoGetLastAutoInc(
  const GeneratorName: string): integer;
begin
  Result := SqliteDbv3_last_insert_rowid(fConnection.Connection);
end;



procedure TDAESQLiteConnection.DoGetTableNames(out List: IROStrings);
var
  i: integer;
begin
  inherited;
  {Giovanni: to avoid return of system table names}
  for i := Pred(List.Count) downto 0 do
    if fConnection.fConnection.IsSystemTable(List.Strings[i]) then List.Delete(i);
end;

{ TDAESQLiteDriver }

procedure TDAESQLiteDriver.CustomizeConnectionObject(
  aConnection: TDAEConnection);
begin
  inherited;
  //TODO:
end;


function TDAESQLiteDriver.GetConnectionClass: TDAEConnectionClass;
begin
  result := TDAESQLiteConnection;
end;

function TDAESQLiteDriver.GetDescription: string;
begin
  result := 'SQLitePass Driver';
end;

function TDAESQLiteDriver.GetDriverID: string;
begin
  result := 'SQLitePass';
end;

procedure TDAESQLiteDriver.GetAuxParams(const AuxDriver: string;
  out List: IROStrings);
begin
  inherited;
  //TODO: TDAESQLiteDriver.GetAuxParams()
  //List.Add('TransactionType=(DEFAULT,DEFERRED,IMMEDIATE,EXCLUSIVE)');
  List.Add('DatabaseType=(dbtSqlitePass, dbtKexi, dbtSqliteAdmin, dbtSqlite4Fpc, dbtSqliteExpert, dbtUnknown)');
  List.Add('SqliteLibrary=path to sqlitepass3.dll or libsqlitepass3.so');
  List.Add('DatatypeOptions.<Param>=<Value>');
  List.Add('Options.<Param>=<Value>');

  List.Add('');
  List.Add('Consult to SQLitePass documentation about DatatypeOptions and Options options.');

  //List.Add('CharacterEncoding=(STANDARD,UTF8)');
end;

{ TDAESQLiteQuery }

procedure TDAESQLiteQuery.ClearParams;
begin
  inherited;
  TSqlitePassDataset(Dataset).Params.Clear;
end;

function TDAESQLiteQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
begin
  result := TSqlitePassDataset.Create(nil);
  TSqlitePassDataset(Result).Database := TDAESQLiteConnection(aConnection).fConnection.Connection;
  if not TDAESQLiteConnection(aConnection).GetConnected then TDAESQLiteConnection(aConnection).Open
end;

function TDAESQLiteQuery.DoExecute: integer;
begin
  Result := -1;
  TSqlitePassDataset(Dataset).Open;
end;

function TDAESQLiteQuery.DoGetSQL: string;
begin
  result := TSqlitePassDataset(Dataset).SQL.Text;
end;

procedure TDAESQLiteQuery.DoPrepare(Value: boolean);
begin
  // nothing
end;

procedure TDAESQLiteQuery.DoSetSQL(const Value: string);
begin
  TSqlitePassDataset(Dataset).SQL.Text := Value;
end;

procedure TDAESQLiteQuery.GetParamValues(AParams: TDAParamCollection);
begin
  GetParamValuesStd(AParams, TSqlitePassDataset(Dataset).Params);
end;

procedure TDAESQLiteQuery.SetParamValues(AParams: TDAParamCollection);
begin
  SetParamValuesStd(AParams, TSqlitePassDataset(Dataset).Params);
end;

exports GetDriverObject name func_GetDriverObject;

initialization
{$IFDEF FPC}
  {$I DataAbstract_SQLitePassDriver_Glyphs.lrs}
{$ENDIF}
  _driver := nil;
  RegisterDriverProc(GetDriverObject);
finalization
  UnregisterDriverProc(GetDriverObject);
  FreeAndNIL(_driver);
end.