
//////////////////////////////////////////////////
//  Universal Data Access Components
//  Copyright © 2008-2014 Devart. All right reserved.
//////////////////////////////////////////////////

{$IFNDEF CLR}
{$I LiteDac.inc}
{$IFDEF VER10P}
{$I SQLiteUniProvider.inc}
{$ENDIF}
unit SQLiteUniProvider;
{$ENDIF}

interface

uses
  SysUtils, Classes, Variants, DB,
  CRAccess, CRConnectionPool, MemData, CRDataTypeMap,
{$IFDEF CLR}
  System.Text, System.Runtime.InteropServices,
{$ELSE}
  CLRClasses,
{$ENDIF}
  {$IFNDEF FPC}MemDS{$ELSE}MemDataSet{$ENDIF}, CRTypes, CRParser, DBAccess,
  DAScript, DADump, Uni, UniProvider,
{$IFNDEF UNIDACPRO}
  LiteCall, LiteClasses, LiteCollation, LiteFunction
{$ELSE}
  LiteCallUni, LiteClassesUni, LiteCollationUni, LiteFunctionUni
{$ENDIF}
;

type

{$IFDEF VER16P}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 {$IFNDEF STD}{$IFDEF VER18P}or pidiOSSimulator or pidiOSDevice{$IFDEF VER19P} or pidAndroid{$ENDIF}{$ENDIF}{$ENDIF})]
{$ENDIF}
  TSQLiteUniProvider = class(TUniProvider)
  public
    class function GetProviderName: string; override;

    function IsServerSupported: boolean; override;
    function IsDatabaseSupported: boolean; override;
    function IsPortSupported: boolean; override;
    function IsInOutParamSupported: boolean; override;
    function IsPoolingSupported: boolean; override;

    function GetParserClass: TSQLParserClass; override;
    function GetConnectionParametersClass: TCRConnectionParametersClass; override;
    function GetConnectionPoolingManagerClass: TCRConnectionPoolManagerClass; override;
    function GetConnectionClass: TCRConnectionClass; override;
    function GetServerEnumeratorClass: TCRServerEnumeratorClass; override;
    function GetTransactionClass: TCRTransactionClass; override;
    function GetCommandClass: TCRCommandClass; override;
    function GetRecordSetClass: TCRRecordSetClass; override;
    function GetDataSetServiceClass: TDADataSetServiceClass; override;
    function GetScriptProcessorClass: TDAScriptProcessorClass; override;
    function GetLoaderClass: TCRLoaderClass; override;
    function GetDumpProcessorClass: TDADumpProcessorClass; override;
    function GetMetaDataClass: TCRMetaDataClass; override;
    function GetConnectDialogServiceClass: TConnectDialogServiceClass; override;
    function GetFieldTypeMapClass: TDAFieldTypeMapClass; override;
    function GetSqlFormatterClass: TUniSqlFormatterClass; override;
    function GetConverterManagerClass: TConverterManagerClass; override;

    procedure SetObjectProps(Obj: TObject; Options: TStrings; SetAllProps: boolean); override;

    function GetConnectionOptions: TOptionsList; override;
    function GetSQLOptions: TOptionsList; override;
    function GetDataSetOptions: TOptionsList; override;
    function GetScriptOptions: TOptionsList; override;
    function GetLoaderOptions: TOptionsList; override;
  end;

  TLiteConnectDialogService = class(TConnectDialogService)
  public
    function UseDatabaseHistory: boolean; override;
    function UsernameEnabled: boolean; override;
    function PasswordEnabled: boolean; override;
    function ServerEnabled: boolean; override;
  end;

  TLiteFormatter = class(TUniSqlFormatter)
  protected
  public
    constructor Create; override;
  end;

  TLiteUtils = class
  private
    class function GetConnection(Connection: TCustomDAConnection): TSQLiteConnection;
  public
    { SQLite user collations }
    class procedure RegisterCollation(Connection: TCustomDAConnection; Name: string; LiteCollation: TLiteCollation);
    class procedure UnRegisterCollation(Connection: TCustomDAConnection; Name: string);
    class procedure RegisterAnsiCollation(Connection: TCustomDAConnection; Name: string; LiteAnsiCollation: TLiteAnsiCollation);
    class procedure UnRegisterAnsiCollation(Connection: TCustomDAConnection; Name: string);
    class procedure RegisterWideCollation(Connection: TCustomDAConnection; Name: string; LiteWideCollation: TLiteWideCollation);
    class procedure UnRegisterWideCollation(Connection: TCustomDAConnection; Name: string);

    { SQLite user functions }
    class procedure RegisterFunction(Connection: TCustomDAConnection; Name: string; ParamCount: Integer; LiteFunction: TLiteFunction);
    class procedure UnRegisterFunction(Connection: TCustomDAConnection; Name: string; ParamCount: Integer);

    { SQLite encryption }
    class procedure EncryptDatabase(Connection: TCustomDAConnection; NewKey: string);
  end;

{$IFNDEF FPC}
procedure RegisterComponent;
{$ELSE}
procedure Register;
{$ENDIF}

implementation

uses
  DAConsts, UniConsts, DALoader, UniLoader,
{$IFNDEF UNIDACPRO}
  LiteConsts, LiteParser, LiteServices, LiteDataTypeMap;
{$ELSE}
  LiteConstsUni, LiteParserUni, LiteServicesUni, LiteDataTypeMapUni;
{$ENDIF}

var
  LiteFunctions, LiteMacros: TStrValueStringList;

class function TSQLiteUniProvider.GetProviderName: string;
begin
  Result := 'SQLite';
end;

function TSQLiteUniProvider.IsServerSupported: boolean;
begin
  Result := False;
end;

function TSQLiteUniProvider.IsDatabaseSupported: boolean;
begin
  Result := True;
end;

function TSQLiteUniProvider.IsPortSupported: boolean;
begin
  Result := False;
end;

function TSQLiteUniProvider.IsInOutParamSupported: boolean;
begin
  Result := False;
end;

function TSQLiteUniProvider.IsPoolingSupported: boolean;
begin
  Result := False;
end;

function TSQLiteUniProvider.GetParserClass: TSQLParserClass;
begin
  Result := TLiteParser;
end;

function TSQLiteUniProvider.GetConnectionParametersClass: TCRConnectionParametersClass;
begin
  Result := TCRConnectionParameters;
end;

function TSQLiteUniProvider.GetConnectionPoolingManagerClass: TCRConnectionPoolManagerClass;
begin
  Result := TCRConnectionPoolManager;
end;

function TSQLiteUniProvider.GetConverterManagerClass: TConverterManagerClass;
begin
  Result := TLiteConverterManager;
end;

function TSQLiteUniProvider.GetConnectionClass: TCRConnectionClass;
begin
  Result := TSQLiteConnection;
end;

function TSQLiteUniProvider.GetServerEnumeratorClass: TCRServerEnumeratorClass;
begin
  Result := TLiteServerEnumerator;
end;

function TSQLiteUniProvider.GetTransactionClass: TCRTransactionClass;
begin
  Result := TSQLiteTransaction;
end;

function TSQLiteUniProvider.GetCommandClass: TCRCommandClass;
begin
  Result := TSQLiteCommand;
end;

function TSQLiteUniProvider.GetRecordSetClass: TCRRecordSetClass;
begin
  Result := TSQLiteRecordSet;
end;

function TSQLiteUniProvider.GetDataSetServiceClass: TDADataSetServiceClass;
begin
  Result := TCustomLiteDataSetService;
end;

function TSQLiteUniProvider.GetScriptProcessorClass: TDAScriptProcessorClass;
begin
  Result := TLiteScriptProcessor;
end;

function TSQLiteUniProvider.GetLoaderClass: TCRLoaderClass;
begin
  Result := TSQLiteLoader;
end;

function TSQLiteUniProvider.GetDumpProcessorClass: TDADumpProcessorClass;
begin
  Result := TCustomLiteDumpProcessor;
end;

function TSQLiteUniProvider.GetMetaDataClass: TCRMetaDataClass;
begin
  Result := TSQLiteMetaData;
end;

function TSQLiteUniProvider.GetConnectDialogServiceClass: TConnectDialogServiceClass;
begin
  Result := TLiteConnectDialogService;
end;

function TSQLiteUniProvider.GetFieldTypeMapClass: TDAFieldTypeMapClass;
begin
  Result := TCustomLiteFieldTypeMap;
end;

function TSQLiteUniProvider.GetSqlFormatterClass: TUniSqlFormatterClass;
begin
  Result := TLiteFormatter;
end;

procedure TSQLiteUniProvider.SetObjectProps(Obj: TObject; Options: TStrings; SetAllProps: boolean);
begin
  if Obj is TUniLoader then
    GetLoaderOptions.ImportOptions(Options, Obj, nil, SetAllProps);

  inherited;
end;

function TSQLiteUniProvider.GetConnectionOptions: TOptionsList;
begin
  if FConnectionOptions = nil then begin
    FConnectionOptions := TOptionsList.Create(GetProviderName);
    FConnectionOptions.Add(TBooleanOption.Create('ASCIIDataBase', prASCIIDataBase, [TSQLiteConnection], False));
    FConnectionOptions.Add(TIntegerOption.Create('BusyTimeout', prBusyTimeout, [TSQLiteConnection], 0));
    FConnectionOptions.Add(TStringOption.Create('ClientLibrary', prClientLibrary, [TSQLiteConnection], '', True));
    FConnectionOptions.Add(TStringOption.Create('DateFormat', prDateFormat, [TSQLiteConnection], ''));
    FConnectionOptions.Add(TStringOption.Create('TimeFormat', prTimeFormat, [TSQLiteConnection], ''));
    FConnectionOptions.Add(TBooleanOption.Create('NativeDate', prNativeDate, [TSQLiteConnection], True));
    FConnectionOptions.Add(TBooleanOption.Create('DefaultCollations', prDefaultCollations, [TSQLiteConnection], True));
  {$IFDEF MSWINDOWS}
    FConnectionOptions.Add(TBooleanOption.Create('EnableSharedCache', prEnableSharedCache, [TSQLiteConnection], False));
  {$ENDIF}
    FConnectionOptions.Add(TBooleanOption.Create('EnableLoadExtension', prEnableLoadExtension, [TSQLiteConnection], False));
    FConnectionOptions.Add(TStringOption.Create('EncryptionKey', prEncryptionKey, [TSQLiteConnection], '', True));
    FConnectionOptions.Add(TBooleanOption.Create('ReadUncommitted', prReadUncommitted, [TSQLiteConnection], False));
    FConnectionOptions.Add(TBooleanOption.Create('ForeignKeys', prForeignKeys, [TSQLiteConnection], True));
    FConnectionOptions.Add(TBooleanOption.Create('UseUnicode', prUseUnicode, [TSQLiteConnection], False, True));
    FConnectionOptions.Add(TBooleanOption.Create('ForceCreateDatabase', prForceCreateDatabase, [TSQLiteConnection], False, True));
  {$IFNDEF NOSTATIC}  
    FConnectionOptions.Add(TBooleanOption.Create('Direct', prStaticLibrary, [TSQLiteConnection], False, True));
    FConnectionOptions.Add(TEnumeratorOption.Create('EncryptionAlgorithm', prEncryptionAlgorithm, [TSQLiteConnection], Variant(leDefault), TypeInfo(TLiteEncryptionAlgorithm)));
  {$ENDIF}
  end;
  Result := FConnectionOptions;
end;

function TSQLiteUniProvider.GetSQLOptions: TOptionsList;
begin
  if FSQLOptions = nil then begin
    FSQLOptions := TOptionsList.Create(GetProviderName);
  end;
  Result := FSQLOptions;
end;

function TSQLiteUniProvider.GetDataSetOptions: TOptionsList;
begin
  if FDataSetOptions = nil then begin
    FDataSetOptions := TOptionsList.Create(GetProviderName);
    FDataSetOptions.Add(TBooleanOption.Create('ExtendedFieldsInfo', prExtendedFieldsInfo, [TSQLiteRecordSet], True));
    FDataSetOptions.Add(TBooleanOption.Create('FetchAll', prFetchAll, [TSQLiteRecordSet], False));
  end;
  Result := FDataSetOptions;
end;

function TSQLiteUniProvider.GetScriptOptions: TOptionsList;
begin
  if FScriptOptions = nil then begin
    FScriptOptions := TOptionsList.Create(GetProviderName);
  end;
  Result := FScriptOptions;
end;

function TSQLiteUniProvider.GetLoaderOptions: TOptionsList;
begin
  if FLoaderOptions = nil then begin
    FLoaderOptions := TOptionsList.Create(GetProviderName);
    FLoaderOptions.Add(TBooleanOption.Create('AutoCommit', prAutoCommit, [TSQLiteLoader], True));
    FLoaderOptions.Add(TIntegerOption.Create('AutoCommitRowCount', prAutoCommitRowCount, [TSQLiteLoader], 1000));
    FLoaderOptions.Add(TBooleanOption.Create('QuoteNames', prQuoteNames, [TSQLiteLoader], False));
  end;
  Result := FLoaderOptions;
end;

{ TLiteConnectDialogService }

function TLiteConnectDialogService.UseDatabaseHistory: boolean;
begin
  Result := True;
end;

function TLiteConnectDialogService.UsernameEnabled: boolean;
begin
  Result := False;
end;

function TLiteConnectDialogService.PasswordEnabled: boolean;
begin
  Result := False;
end;

function TLiteConnectDialogService.ServerEnabled: boolean;
begin
  Result := False;
end;

{ TLiteFormatter }

constructor TLiteFormatter.Create;
begin
  inherited;

  FFunctions := LiteFunctions;
  FPredefinedMacros := LiteMacros;
end;

class function TLiteUtils.GetConnection(Connection: TCustomDAConnection): TSQLiteConnection;
var
  CRConnection: TCRConnection;
begin
  CRConnection := TDBAccessUtils.GetIConnection(Connection);

  if CRConnection = nil then
    raise Exception.Create(SConnectionIsClosed)
  else if not (CRConnection is TSQLiteConnection) then
    raise Exception.CreateFmt(SIncorrectConnectionType, ['TSQLiteConnection', CRConnection.ClassName]);

  Result := TSQLiteConnection(CRConnection);
end;

class procedure TLiteUtils.RegisterCollation(Connection: TCustomDAConnection; Name: string; LiteCollation: TLiteCollation);
begin
  GetConnection(Connection).GetCollationManager.RegisterCollation(Name, LiteCollation);
end;

class procedure TLiteUtils.UnRegisterCollation(Connection: TCustomDAConnection; Name: string);
begin
  GetConnection(Connection).GetCollationManager.UnRegisterCollation(Name);
end;

class procedure TLiteUtils.RegisterAnsiCollation(Connection: TCustomDAConnection; Name: string; LiteAnsiCollation: TLiteAnsiCollation);
begin
  GetConnection(Connection).GetCollationManager.RegisterAnsiCollation(Name, LiteAnsiCollation);
end;

class procedure TLiteUtils.UnRegisterAnsiCollation(Connection: TCustomDAConnection; Name: string);
begin
  GetConnection(Connection).GetCollationManager.UnRegisterAnsiCollation(Name);
end;

class procedure TLiteUtils.RegisterWideCollation(Connection: TCustomDAConnection; Name: string; LiteWideCollation: TLiteWideCollation);
begin
  GetConnection(Connection).GetCollationManager.RegisterWideCollation(Name, LiteWideCollation);
end;

class procedure TLiteUtils.UnRegisterWideCollation(Connection: TCustomDAConnection; Name: string);
begin
  GetConnection(Connection).GetCollationManager.UnRegisterWideCollation(Name);
end;

class procedure TLiteUtils.RegisterFunction(Connection: TCustomDAConnection; Name: string; ParamCount: Integer; LiteFunction: TLiteFunction);
begin
  GetConnection(Connection).GetFunctionManager.RegisterFunction(Name, ParamCount, LiteFunction);
end;

class procedure TLiteUtils.UnRegisterFunction(Connection: TCustomDAConnection; Name: string; ParamCount: Integer);
begin
  GetConnection(Connection).GetFunctionManager.UnRegisterFunction(Name, ParamCount);
end;

class procedure TLiteUtils.EncryptDatabase(Connection: TCustomDAConnection; NewKey: string);
begin
  GetConnection(Connection).EncryptDatabase(NewKey);
end;

{$IFNDEF FPC}
procedure RegisterComponent;
{$ELSE}
procedure Register;
{$ENDIF}
begin
  RegisterComponents('UniDAC Providers', [TSQLiteUniProvider]);
end;

initialization
  UniProviders.RegisterProvider(TSQLiteUniProvider);

  LiteFunctions := TStrValueStringList.Create;
  //LiteFunctions.Add('USER', '');
  LiteFunctions.Add('CHAR_LENGTH', 'LENGTH(%s)');
  //LiteFunctions.Add('LOCATE',      'STRPOS(%1:s, %0:s)');
  LiteFunctions.Add('SUBSTRING',   'SUBSTR(%s, %s, %s)');
  LiteFunctions.Add('CONCAT',      '%s || %s');
  //LiteFunctions.Add('CHAR',        'CHR(%s)');
  LiteFunctions.Add('TRIM',        'TRIM(%s)');
  //LiteFunctions.Add('TRUNCATE',    'TRUNC(%s, %s)');
  //LiteFunctions.Add('CEILING',     'CEILING(%s)');
  // Date-time
  LiteFunctions.Add('CURRENT_DATE', 'CURRENT_DATE');
  //LiteFunctions.Add('YEAR',         'EXTRACT(YEAR FROM %s)');
  //LiteFunctions.Add('MONTH',        'EXTRACT(MONTH FROM %s)');
  //LiteFunctions.Add('DAY',          'EXTRACT(DAY FROM %s)');
  LiteFunctions.Add('DATEADD',      'DATE(%2:s, ''%1:s %0:s'')');
  //LiteFunctions.Add('DATEDIFF',     'EXTRACT(%s FROM (%2:s - %1:s))');
  // Date-time literals
  LiteFunctions.Add('__DATE_TIME_LITERAL', '%s');
  LiteFunctions.Add('__DATE_LITERAL',      '%s');
  LiteFunctions.Add('__TIME_LITERAL',      '%s');
  // CONVERT functions
  LiteFunctions.Add('TODATE',   'CAST(%s AS VARCHAR)');
  LiteFunctions.Add('TONUMBER', 'CAST(%s AS DOUBLE)');
  LiteFunctions.Add('TOCHAR',   'CAST(%s AS VARCHAR)');

  LiteMacros := TStrValueStringList.Create;
  LiteMacros.Add('PROVIDER', 'SQLite');
  LiteMacros.Add('SQLITE',   '');
  // DataType macros
  LiteMacros.Add('DATETIME', 'TEXT');
  LiteMacros.Add('DOUBLE',   'DOUBLE');
  LiteMacros.Add('VARCHAR',  'VARCHAR');

finalization
  UniProviders.UnRegisterProvider(TSQLiteUniProvider);

  LiteFunctions.Free;
  LiteMacros.Free;

end.
