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

{$IFNDEF CLR}
{$I AccessDac.inc}
{$IFDEF VER10P}
{$I AccessUniProvider.inc}
{$ENDIF}
unit AccessUniProvider;
{$ENDIF}

interface

uses
  SysUtils, Classes, Variants, DB, CRAccess, CRConnectionPool, MemData,
  {$IFNDEF FPC}MemDS{$ELSE}MemDataSet{$ENDIF}, DBAccess,
  CRTypes, CRParser, CRDataTypeMap,
  DAScript, DADump, UniProvider, ODBCUniProvider;

type

{$IFDEF VER16P}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
  TAccessUniProvider = class(TODBCUniProvider)
  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 GetConnectionParametersClass: TCRConnectionParametersClass; override;
    function GetConnectionPoolingManagerClass: TCRConnectionPoolManagerClass; override;
    function GetConnectionClass: TCRConnectionClass; override;
    function GetCommandClass: TCRCommandClass; override;
    function GetRecordSetClass: TCRRecordSetClass; override;
    function GetDataSetServiceClass: TDADataSetServiceClass; override;
    function GetLoaderClass: TCRLoaderClass; override;
    function GetConnectDialogServiceClass: TConnectDialogServiceClass; override;
    function GetSqlFormatterClass: TUniSqlFormatterClass; override;
    function GetConverterManagerClass: TConverterManagerClass; override;

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

  TAccessConnectDialogService = class(TConnectDialogService)
  public
    function UseDatabaseHistory: boolean; override;
    function ServerEnabled: boolean; override;
  end;

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

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

implementation

uses
  DAConsts, UniConsts,
{$IFNDEF UNIDACPRO}
  ODBCClasses, ODBCParser, ODBCServices,
  AccessClasses, AccessServices, AccessDataTypeMap;
{$ELSE}
  ODBCClassesUni, ODBCParserUni, ODBCServicesUni,
  AccessClassesUni, AccessServicesUni, AccessDataTypeMapUni;
{$ENDIF}

var
  AccessFunctions, AccessMacros: TStrValueStringList;

class function TAccessUniProvider.GetProviderName: string;
begin
  Result := 'Access';
end;

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

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

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

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

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

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

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

function TAccessUniProvider.GetConnectionClass: TCRConnectionClass;
begin
  Result := TAccessConnection;
end;

function TAccessUniProvider.GetCommandClass: TCRCommandClass;
begin
  Result := TAccessCommand;
end;

function TAccessUniProvider.GetRecordSetClass: TCRRecordSetClass;
begin
  Result := TAccessRecordSet;
end;

function TAccessUniProvider.GetDataSetServiceClass: TDADataSetServiceClass;
begin
  Result := TCustomAccessDataSetService;
end;

function TAccessUniProvider.GetLoaderClass: TCRLoaderClass;
begin
  Result := TAccessLoader;
end;

function TAccessUniProvider.GetConnectDialogServiceClass: TConnectDialogServiceClass;
begin
  Result := TAccessConnectDialogService;
end;

function TAccessUniProvider.GetSqlFormatterClass: TUniSqlFormatterClass;
begin
  Result := TAccessFormatter;
end;

function TAccessUniProvider.GetConverterManagerClass: TConverterManagerClass;
begin
  Result := TAccessConverterManager;
end;

function TAccessUniProvider.GetConnectionOptions: TOptionsList;
begin
  if FConnectionOptions = nil then begin
    FConnectionOptions := TOptionsList.Create(GetProviderName);
    FConnectionOptions.Add(TIntegerOption.Create('ConnectionTimeout', prConnectionTimeout, [TAccessConnection], 15, True));
    FConnectionOptions.Add(TBooleanOption.Create('ExclusiveLock', prExclusiveLock, [TAccessConnection], False, True));
    FConnectionOptions.Add(TBooleanOption.Create('ExtendedAnsiSQL', prExtendedAnsiSQL, [TAccessConnection], False, True));
    FConnectionOptions.Add(TBooleanOption.Create('ForceCreateDatabase', prForceCreateDatabase, [TAccessConnection], False, True));
    FConnectionOptions.Add(TStringOption.Create('SystemDatabase', prSystemDatabase, [TAccessConnection], '', True));
    FConnectionOptions.Add(TBooleanOption.Create('UseUnicode', prUseUnicode, [TAccessConnection], False, True));
  end;
  Result := FConnectionOptions;
end;

function TAccessUniProvider.GetSQLOptions: TOptionsList;
begin
  if FSQLOptions = nil then begin
    FSQLOptions := TOptionsList.Create(GetProviderName);
    FSQLOptions.Add(TIntegerOption.Create('CommandTimeout', prCommandTimeout, [TAccessCommand], 0));
  end;
  Result := FSQLOptions;
end;

function TAccessUniProvider.GetDataSetOptions: TOptionsList;
begin
  if FDataSetOptions = nil then begin
    FDataSetOptions := TOptionsList.Create(GetProviderName);
    FDataSetOptions.Add(TIntegerOption.Create('CommandTimeout', prCommandTimeout, [TAccessRecordSet], 0));
    FDataSetOptions.Add(TBooleanOption.Create('ExtendedFieldsInfo', prExtendedFieldsInfo, [TAccessRecordSet], True));
    FDataSetOptions.Add(TBooleanOption.Create('FetchAll', prFetchAll, [TAccessRecordSet], True));
  end;
  Result := FDataSetOptions;
end;

{ TAccessConnectDialogService }

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

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

{ TAccessFormatter }

constructor TAccessFormatter.Create;
begin
  inherited;

  FFunctions := AccessFunctions;
  FPredefinedMacros := AccessMacros;
end;

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

initialization
  UniProviders.RegisterProvider(TAccessUniProvider);

  AccessFunctions := TStrValueStringList.Create;
  AccessFunctions.Add('USER', 'USER');
  AccessFunctions.Add('CHAR_LENGTH', 'LEN(%s)');
  AccessFunctions.Add('LOCATE', 'POSSTR(%1:s, %0:s)');
  AccessFunctions.Add('SUBSTRING', 'SUBSTR(%s, %s, %s)');
  AccessFunctions.Add('CONCAT', '%s + %s');
  AccessFunctions.Add('CHAR', 'CHAR(%s)');
  AccessFunctions.Add('TRIM', 'TRIM(%s)');
  AccessFunctions.Add('TRUNCATE', 'TRUNC(%s, %s)');
  AccessFunctions.Add('CEILING', 'CEILING(%s)');
  // Date-time
  AccessFunctions.Add('CURRENT_DATE', 'CURRENT_DATE');
  AccessFunctions.Add('YEAR', 'YEAR(%s)');
  AccessFunctions.Add('MONTH', 'MONTH(%s)');
  AccessFunctions.Add('DAY', 'DAY(%s)');
  //AccessFunctions.Add('DATEADD', 'DATE(%2:s, ''%1:s %0:s'')');
  //AccessFunctions.Add('DATEDIFF', 'EXTRACT(%s FROM (%2:s - %1:s))');
  // Date-time literals
  AccessFunctions.Add('__DATE_TIME_LITERAL', '(%s)');
  AccessFunctions.Add('__DATE_LITERAL', '(%s)');
  AccessFunctions.Add('__TIME_LITERAL', '(%s)');
  // CONVERT functions
  AccessFunctions.Add('TODATE', '(%s)');
  AccessFunctions.Add('TONUMBER', '(%s)');
  AccessFunctions.Add('TOCHAR', '(%s)');

  AccessMacros := TStrValueStringList.Create;
  AccessMacros.Add('PROVIDER', 'Access');
  AccessMacros.Add('ACCESS', '');
  // DataType macros
  AccessMacros.Add('DATETIME', 'DATE');
  AccessMacros.Add('DOUBLE', 'DOUBLE');
  AccessMacros.Add('VARCHAR', 'TEXT');

finalization
  UniProviders.UnRegisterProvider(TAccessUniProvider);

  AccessFunctions.Free;
  AccessMacros.Free;

end.
