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

{$IFNDEF CLR}

{$I AccessDac.inc}
unit AccessClassesUni;
{$ENDIF}

interface

uses
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
{$IFDEF CLR}
  System.Security, System.Text, System.Runtime.InteropServices,
{$ELSE}
  CLRClasses,
{$ENDIF}
  Classes, SysUtils, Variants, SyncObjs,
{$IFNDEF FPC}
  FMTBcd,
{$ENDIF}
{$IFDEF VER12P}
  AnsiStrings,
{$ENDIF}
  CRTypes, MemData, CRAccess, CRParser, CRDataTypeMap,
{$IFNDEF UNIDACPRO}
  ODBCCall, ODBCClasses, AccessParser;
{$ELSE}
  ODBCCallUni, ODBCClassesUni, AccessParserUni;
{$ENDIF}

const
  prAccessBase = 2000;

  prSystemDatabase      = prAccessBase + 1;
  prExtendedAnsiSQL     = prAccessBase + 2;
  prExclusiveLock       = prAccessBase + 3;
  prForceCreateDatabase = prAccessBase + 4;

type
{ TAccessConnection }

  TAccessConnection = class(TODBCConnection)
  private
    FDatabase: string;
    FSystemDatabase: string;
    FExtendedAnsiSQL: Boolean;
    FExclusiveLock: Boolean;
    FForceCreateDatabase: boolean;
  protected
    function GetConnectionString: string; override;
    function IsCommentAllowed: boolean; override;
    function IsEmptyStringAllowed: boolean; override;

  public
    function GetCommandClass: TCRCommandClass; override;

    procedure Connect(const ConnectString: string); override;
    
    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; out Value: variant): boolean; override;

    procedure Assign(Source: TCRConnection); override;
  end;

{ TAccessSQLInfo }

  TAccessSQLInfo = class(TODBCSQLInfo)
  public
    function LeftQuote: char; override;
    function RightQuote: char; override;
    function IdentCase: TIdentCase; override;
  end;

{ TAccessCommand }

  TAccessCommand = class(TODBCCommand)
  protected
    function GetBlobSize(SQLLength: longword): Integer; override;
  public
    class function GetSQLInfoClass: TSQLInfoClass; override;
    class function GetParserClass: TSQLParserClass; override;
    class function GetMapRulesClass: TCRMapRulesClass; override;
  end;

{ TAccessRecordSet }

  TAccessRecordSet = class(TODBCRecordSet)
  protected
    procedure CreateCommand; override;
  end;

{$IFNDEF LITE}

{ TAccessLoader }

  TAccessLoader = class (TODBCLoader)
  protected
    procedure CreateCommand; override;
    class function GetRecordSetClass: TCRRecordSetClass; override;
  end;
{$ENDIF}

implementation

uses
  CRFunctions, DAConsts,
{$IFNDEF UNIDACPRO}
  ODBCConsts, AccessDataTypeMap, AccessCall;
{$ELSE}
  ODBCConstsUni, AccessDataTypeMapUni, AccessCallUni;
{$ENDIF}

{ TAccessConnection }

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

function TAccessConnection.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prDatabase:
      FDatabase := Value;
    prSystemDatabase:
      FSystemDatabase := Value;
    prExtendedAnsiSQL:
      FExtendedAnsiSQL := Value;
    prExclusiveLock:
      FExclusiveLock := Value;
    prForceCreateDatabase:
      FForceCreateDatabase := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TAccessConnection.GetProp(Prop: integer; out Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prDatabase:
      Value := FDatabase;
    prSystemDatabase:
      Value := FSystemDatabase;
    prMaxStringSize:
      Value := 255;
    prExtendedAnsiSQL:
      Value := FExtendedAnsiSQL;
    prExclusiveLock:
      Value:= FExclusiveLock;
    prForceCreateDatabase:
      Value := FForceCreateDatabase;
  else
    Result := inherited GetProp(Prop, Value);
  end;
end;

procedure TAccessConnection.Assign(Source: TCRConnection);
begin
  inherited;

  FDatabase := TAccessConnection(Source).FDatabase;
  FSystemDatabase := TAccessConnection(Source).FSystemDatabase;
  FExtendedAnsiSQL := TAccessConnection(Source).FExtendedAnsiSQL;
  FExclusiveLock := TAccessConnection(Source).FExclusiveLock;
  FForceCreateDatabase := TAccessConnection(Source).FForceCreateDatabase;
end;

function TAccessConnection.GetConnectionString: string;
var
  DefaultDir: string;
begin
  DefaultDir := ExtractFilePath(FDatabase);
  if IsDriverPresent('Microsoft Access Driver (*.mdb, *.accdb)') then
    Result := Format('DRIVER={Microsoft Access Driver (*.mdb, *.accdb)};DefaultDir=%s;DBQ=%s;UID=%s;PWD=%s',
      [DefaultDir, FDatabase, FUsername, FPassword])
  else
    Result := Format('DRIVER={Microsoft Access Driver (*.mdb)};DefaultDir=%s;DBQ=%s;UID=%s;PWD=%s',
      [DefaultDir, FDatabase, FUsername, FPassword]);

  if FExclusiveLock then
    Result:= Result +  ';Exclusive=1';

  if FSystemDatabase <> '' then
    Result := Result + ';SystemDB=' + FSystemDatabase;

  if FExtendedAnsiSQL then
    Result := Result + ';ExtendedAnsiSQL=1';
end;

function TAccessConnection.IsCommentAllowed: boolean;
begin
  Result := False;
end;

function TAccessConnection.IsEmptyStringAllowed: boolean;
begin
  Result := True;
end;

procedure TAccessConnection.Connect(const ConnectString: string);
begin
  if FForceCreateDatabase then
    CreateNewDataBase(FDatabase);

  inherited Connect(ConnectString);
end;

{ TAccessSQLInfo }

function TAccessSQLInfo.LeftQuote: char;
begin
  Result := '`';
end;

function TAccessSQLInfo.RightQuote: char;
begin
  Result := '`';
end;

function TAccessSQLInfo.IdentCase: TIdentCase;
begin
  Result := icMixed;
end;

{ TAccessCommand }

function TAccessCommand.GetBlobSize(SQLLength: longword): Integer;
begin
  if Integer(SQLLength) = 1073741823 then
    Result := 0
  else
    Result := inherited GetBlobSize(SQLLength);
end;

class function TAccessCommand.GetSQLInfoClass: TSQLInfoClass;
begin
  Result := TAccessSQLInfo;
end;

class function TAccessCommand.GetParserClass: TSQLParserClass;
begin
  Result := TAccessParser;
end;

class function TAccessCommand.GetMapRulesClass: TCRMapRulesClass;
begin
  Result := TAccessMapRules;
end;

{ TAccessRecordSet }

procedure TAccessRecordSet.CreateCommand;
begin
  SetCommand(TAccessCommand.Create);
end;

{$IFNDEF LITE}

{ TAccessLoader }

procedure TAccessLoader.CreateCommand;
begin
  FCommand := TAccessCommand.Create;
end;

class function TAccessLoader.GetRecordSetClass: TCRRecordSetClass;
begin
  Result := TAccessRecordSet;
end;

{$ENDIF}

end.
