
/////////////////////////////////////////////////////////
//                                                     //
//            Bold Accuracer DB DataBase Adapter       //
//           Copyright (c) 2004 Borland, Grikon        //
//                                                     //
/////////////////////////////////////////////////////////

{ Global compiler directives }

{$include bold.inc}

unit BoldACRInterfaces;

                                   INTERFACE
uses
  Classes,
  Db, ACRMain,
  BoldSQLDatabaseConfig,
  BoldDBInterfaces;
type
  { forward declarations }

  TBoldACCParameter = class;
  TBoldACCDatabase = class;
  TBoldACCQuery = class;
  TBoldACCQueryClass = class of TBoldACCQuery;


  { TBoldACCParameter }
  TBoldACCParameter = class(TBoldParameterWrapper, IBoldParameter)
  private
    fParameter: TParam;
    function GetAsVariant: Variant;
    procedure SetAsVariant(const NewValue: Variant);
    function GetName: String;
    procedure Clear;
    function GetDataType: TFieldType;
    procedure SetDataType(Value: TFieldType);
    function GetAsBCD: Currency;
    function GetAsBoolean: Boolean;
    function GetAsDateTime: TDateTime;
    function GetAsCurrency: Currency;
    function GetAsFloat: Double;
    function GetAsInteger: Longint;
    function GetAsMemo: string;
    function GetAsString: string;
    function GetIsNull: Boolean;
    procedure SetAsBCD(const Value: Currency);
    procedure SetAsBlob(const Value: TBlobData);
    procedure SetAsBoolean(Value: Boolean);
    procedure SetAsCurrency(const Value: Currency);
    procedure SetAsDate(const Value: TDateTime);
    procedure SetAsDateTime(const Value: TDateTime);
    procedure SetAsFloat(const Value: Double);
    procedure SetAsInteger(Value: Longint);
    procedure SetAsMemo(const Value: string);
    procedure SetAsString(const Value: string);
    procedure SetAsSmallInt(Value: LongInt);
    procedure SetAsTime(const Value: TDateTime);
    procedure SetAsWord(Value: LongInt);
    procedure SetText(const Value: string);
    function GetParameter: TParam;
    procedure AssignFieldValue(source: IBoldField);
    property Parameter: TParam read GetParameter;
  public
    constructor create(ACCParameter: TParam; DatasetWrapper: TBoldDatasetWrapper);
  end;
 
  { TBoldACCQuery }
  TBoldACCQuery = class(TBoldDataSetWrapper, IBoldQuery, IBoldExecQuery, IBoldParameterized)
  private
    FQuery: TACRQuery;
    function GetParamCount: integer;
    function GetParams(i: integer): IBoldParameter;
    function GetQuery: TACRQuery;
    function GetRecordCount: integer;
    function GetRequestLiveQuery: Boolean;
    procedure ClearParams;
    function GetRowsAffected: integer;
    function GetSQLText: String;
    function ParamByName(const Value: string): IBoldParameter;
    procedure AssignParams(Sourceparams: TParams);
    procedure AssignSQL(SQL: TStrings);
    procedure AssignSQLText(SQL: String);
    procedure SetRequestLiveQuery(NewValue: Boolean);
    function Createparam(FldType: TFieldType; const ParamName: string; ParamType: TParamType; Size: integer): IBoldParameter;
  protected
    function GetDataSet: TDataSet; override;
    procedure EndSQLBatch; virtual;
    procedure ExecSQL;
    procedure FailSQLBatch; virtual;
    procedure Open; override;
    procedure StartSQLBatch; virtual;
    property Query: TACRQuery read GetQuery;
  public
    constructor Create(Query: TACRQuery; DatabaseWrapper: TBoldDatabaseWrapper);
  end;

  { TBoldACCDataBase }
  TBoldACCDatabase = class(TBolddatabaseWrapper, IBoldDataBase)
  private
    FDatabase: TACRDatabase;
    FCachedQuery: TACRQuery;
    function GetConnected: Boolean;
    function GetDataBase: TACRDatabase;
    function GetInTransaction: Boolean;
    function GetIsSQLBased: Boolean;
    function GetKeepConnection: Boolean;
    function GetLogInPrompt: Boolean;
    function SupportsTableCreation: boolean;
    procedure Close;
    procedure Commit;
    procedure Open;
    function GetTable: IBoldTable;
    procedure ReleaseTable(var Table: IBoldTable);
    procedure Rollback;
    procedure SetKeepConnection(NewValue: Boolean);
    procedure SetlogInPrompt(NewValue: Boolean);
    procedure StartTransaction;
    property Database: TACRDatabase read GetDatabase;
    procedure ReleaseCachedObjects;
  protected
    procedure AllTableNames(Pattern: String; ShowSystemTables: Boolean; TableNameList: TStrings); override;
    function GetQuery: IBoldQuery; override;
    procedure ReleaseQuery(var Query: IBoldQuery); override;
  public
    constructor create(Database: TACRDatabase; SQLDataBaseConfig: TBoldSQLDatabaseConfig);
    destructor destroy; override;
  end;

var
  BoldACCQueryClass: TBoldACCQueryClass = TBoldACCQuery;

                                  IMPLEMENTATION

uses
  SysUtils,
  BoldRev,
  BoldUtils,
  dialogs,
  variants,
  strutils, ACRSupport;


{ TBoldACCQuery }
//----------------------------------------------------------------------------------------
procedure TBoldACCQuery.AssignParams(Sourceparams: tparams);
var
  i: integer;
  Opar : TParam;
begin
  Query.Params.Clear;
  if assigned(SourceParams) and (SourceParams.Count > 0) then
  begin
    for i := 0 to Sourceparams.Count - 1 do with OPar do
    begin
      OPar:=Query.Params.CreateParam( Sourceparams[i].DataType,Sourceparams[i].Name, ptInput) as TParam;
      Size:=0;
      Value:=SourceParams[i].Value;
    end;
  end;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.Clear;
begin
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCQuery.AssignSQL(SQL: TStrings);
begin
  Query.SQL.BeginUpdate;
  Query.SQL.Assign(SQL);
  Query.SQL.EndUpdate;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCQuery.AssignSQLText(SQL: String);
begin
  Query.SQL.BeginUpdate;
  Query.SQL.Clear;
  BoldAppendToStrings(Query.SQL, SQL, true);
  Query.SQL.EndUpdate;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCQuery.ClearParams;
begin
  Query.Params.Clear;
end;
//----------------------------------------------------------------------------------------
constructor TBoldACCQuery.Create(Query: TACRQuery; DatabaseWrapper: TBoldDatabaseWrapper);
begin
  inherited create(DatabaseWrapper);
  FQuery := Query;
end;
//----------------------------------------------------------------------------------------
function TBoldACCQuery.CreateParam(FldType: TFieldType; const ParamName: string; ParamType: TParamType; Size: integer): IBoldParameter;
const
  ParamDir: Array[TParamType] of TParamType
           =(ptUnknown, ptInput, ptOutput, ptInputOutput,ptResult);
var MyPar : TParam;
begin
  MyPar:=Query.Params.CreateParam(fldType,ParamName,ParamDir[ParamType]) as TParam;
  result := TBoldACCParameter.Create(MyPar, self);
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCQuery.EndSQLBatch;
begin
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCQuery.ExecSQL;
begin
  Query.SQL.Text := PrepareACRQuery(Query.SQL.text);
  try
    Query.Prepare;
    if CheckCreateStatus(Query.SQL.Text) then
    if  Query.Database.InTransaction then Query.Database.Rollback; // !!!!!!!!!!!!!!!!!
    Query.ExecSQL;
  except
    on E: Exception do MessageDlg(E.Message + #13#10 +Query.SQL.Text, mtError, [mbOk], 0);
    end;
  end;
//----------------------------------------------------------------------------------------
procedure TBoldACCQuery.FailSQLBatch;
begin
end;
//----------------------------------------------------------------------------------------
function TBoldACCQuery.GetDataSet: TDataSet;
begin
  result := Query;
end;
//----------------------------------------------------------------------------------------
function TBoldACCQuery.GetParamCount: integer;
begin
  result := Query.Params.count;
end;
//----------------------------------------------------------------------------------------
function TBoldACCQuery.GetParams(i: integer): IBoldParameter;
begin
  result := TBoldACCParameter.Create(Query.Params[i], self);
end;
//----------------------------------------------------------------------------------------
function TBoldACCQuery.GetQuery: TACRQuery;
begin
  result := FQuery;
end;
//----------------------------------------------------------------------------------------
function TBoldACCQuery.GetRecordCount: integer;
begin
  Result := Query.RecordCount;
end;
//----------------------------------------------------------------------------------------
function TBoldACCQuery.GetRequestLiveQuery: Boolean;
begin
  result := false;
end;
//----------------------------------------------------------------------------------------
function TBoldACCQuery.GetRowsAffected: integer;
begin
  result := Query.RowsAffected;
end;
//----------------------------------------------------------------------------------------
function TBoldACCQuery.GetSQLText: String;
begin
  result := Query.SQL.Text;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCQuery.Open;
var
  st:string;
  lskob,rskob,ltpos, badpos: integer;
begin
  st := Query.SQL.Text;
  st := LowerCase(st);
  repeat
    badpos :=Pos(#13, st);
    if badpos > 0 then
    begin
      System.Delete(st, badpos, 1);
      System.Insert(' ', st, badpos);
    end;
    badpos :=Pos(#10, st);
    if badpos > 0 then
    begin
      System.Delete(st, badpos, 1);
      System.Insert(' ', st, badpos);
    end;
  until badpos = 0;
  // ищем linktable_alias и убираем скобки вокруг него
  ltpos :=Pos('linktable_alias', st);
  if ltpos > 0 then
  begin
    // проверяем есть ли левая скобка
    lskob := PosEx('(', st, ltpos-1);
    if lskob > 0 then
    begin
      // удаляем левую скобку
      System.Delete(st, lskob, 1);
      System.Insert(' ', st, lskob);
     // удаляем правую скобку
      rskob := PosEx(')', st, ltpos+2);
      System.Delete(st, rskob, 1);
      System.Insert(' ', st, rskob);
    end;
  end;
  Query.SQL.Text := st;
  BoldLogSQL(Query.SQL);
  inherited;
end;
//----------------------------------------------------------------------------------------
function TBoldACCQuery.ParamByName(const Value: string): IBoldParameter;
var
  Param: TParam;
begin
  Param := Query.ParamByName(Value);
  if assigned(Param) then result := TBoldACCParameter.Create(Param, self)
  else result := nil;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCQuery.SetRequestLiveQuery(NewValue: Boolean);
begin
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCQuery.StartSQLBatch;
begin
end;
//----------------------------------------------------------------------------------------
{ TBoldACCDataBase }
//----------------------------------------------------------------------------------------
procedure TBoldACCDatabase.AllTableNames(Pattern: String; ShowSystemTables: Boolean; TableNameList: TStrings);
begin
  Database.GetTablesList(TableNameList);
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCDatabase.Close;
begin
  Database.Close;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCDatabase.Commit;
begin
  Database.Commit;
end;
//----------------------------------------------------------------------------------------
constructor TBoldACCDatabase.create(DataBase: TACRDatabase; SQLDataBaseConfig: TBoldSQLDatabaseConfig);
begin
  inherited create(SQLDataBaseConfig);
  FDataBase := DataBase;
end;
//----------------------------------------------------------------------------------------
destructor TBoldACCDatabase.destroy;
begin
  inherited;
  FDatabase := nil;
  FreeAndNil(fCachedQuery);
end;
//----------------------------------------------------------------------------------------
function TBoldACCDatabase.GetConnected: Boolean;
begin
  result := Database.Connected;
end;
//----------------------------------------------------------------------------------------
function TBoldACCDatabase.GetDataBase: TACRDatabase;
begin
  result := FDataBase;
end;
//----------------------------------------------------------------------------------------
function TBoldACCDatabase.GetInTransaction: Boolean;
begin
  result := Database.InTransaction;
end;
//----------------------------------------------------------------------------------------
function TBoldACCDatabase.GetIsSQLBased: Boolean;
begin
  result := true;
end;
//----------------------------------------------------------------------------------------
function TBoldACCDatabase.GetKeepConnection: Boolean;
begin
  result := true;
end;
//----------------------------------------------------------------------------------------
function TBoldACCDatabase.GetLogInPrompt: Boolean;
begin
                                      Result := True;
//  result := dataBase.LoginPrompt;
end;
//----------------------------------------------------------------------------------------
function TBoldACCDatabase.GetQuery: IBoldQuery;
var
  Query: TACRQuery;
begin
  if assigned(fCachedQuery) then
  begin
    Query := fCachedQuery;
    fCachedQuery := nil;
  end
  else
  begin
    Query := TACRQuery.Create(nil);
//    Query.ChangeCurrentDatabaseName(Database.DatabaseName);
    Query.DatabaseName := Database.DatabaseName;
  end;
  result := BoldACCQueryClass.Create(Query, self);
end;
//----------------------------------------------------------------------------------------
function TBoldACCDatabase.GetTable: IBoldTable;
begin
  result := nil;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCDatabase.Open;
begin
  Database.Open;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCDatabase.ReleaseCachedObjects;
begin
  FreeAndNil(fCachedQuery);
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCDatabase.ReleaseQuery(var Query: IBoldQuery);
var
  AccQuery: TBoldACCQuery;
begin
  if Query.Implementor is TBoldACCQuery then begin
    AccQuery := Query.Implementor as TBoldACCQuery;
    Query := nil;
    if not assigned(FCachedQuery) then begin
      FCachedQuery := AccQuery.FQuery;
      if FCachedQuery.Active then
        FCachedQuery.Close;
      FCachedQuery.SQL.Clear;
    end
    else
      AccQuery.FQuery.free;
    AccQuery.Free;
  end;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCDatabase.ReleaseTable(var Table: IBoldTable);
begin
  raise Exception.Create('BoldACCAdapter.ReleaseTable: Operation not supported');
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCDatabase.Rollback;
begin
  Database.Rollback;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCDatabase.SetKeepConnection(NewValue: Boolean);
begin
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCDatabase.SetlogInPrompt(NewValue: Boolean);
begin
//  Database.LoginPrompt := NewValue;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCDatabase.StartTransaction;
begin
  Database.StartTransaction;
end;
//----------------------------------------------------------------------------------------
function TBoldACCDatabase.SupportsTableCreation: boolean;
begin
                                        result := true;
end;
//----------------------------------------------------------------------------------------
constructor TBoldACCParameter.create(ACCParameter: TParam; DatasetWrapper: TBoldDatasetWrapper);
begin
  inherited Create(DatasetWrapper);
  fParameter := ACCParameter;
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetAsBCD: Currency;
begin
  result := parameter.Value;
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetAsBoolean: Boolean;
begin
  result := parameter.Value;
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetAsCurrency: Currency;
begin
  result := parameter.Value;
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetAsDateTime: TDateTime;
begin
  result := parameter.Value;
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetAsFloat: Double;
begin
  result := parameter.Value;
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetAsInteger: Longint;
begin
  result := parameter.Value;
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetAsMemo: string;
begin
  result := parameter.Value;
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetAsString: string;
begin
  result := parameter.Value;
  if result = DatasetWrapper.DatabaseWrapper.SQLDatabaseConfig.EmptyStringMarker then
  result := '';
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetAsVariant: Variant;
begin
  result := parameter.Value;
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetDataType: TFieldType;
begin
  result := parameter.DataType;
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetIsNull: Boolean;
begin
  result := VarIsNull(Parameter.value)
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetName: String;
begin
  result := Parameter.Name;
end;
//----------------------------------------------------------------------------------------
function TBoldACCParameter.GetParameter: TParam;
begin
  result := fParameter;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsBCD(const Value: Currency);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsBlob(const Value: TBlobData);
begin
  with Parameter do begin
  if (DataType = ftUnknown) or (DataType = ftBlob)
  then  begin
          DataType := ftBlob;
          ParamType:=ptInput;
        end;
  end;
  if value = '' then
    Parameter.Value := DatasetWrapper.DatabaseWrapper.SQLDatabaseConfig.EmptyStringMarker
  else
    Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsBoolean(Value: Boolean);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsCurrency(const Value: Currency);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsDate(const Value: TDateTime);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsDateTime(const Value: TDateTime);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsFloat(const Value: Double);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsInteger(Value: Integer);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsMemo(const Value: string);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsSmallInt(Value: Integer);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsString(const Value: string);
begin
  if value = '' then
    Parameter.Value := DatasetWrapper.DatabaseWrapper.SQLDatabaseConfig.EmptyStringMarker
  else
    Parameter.Value := Value
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsTime(const Value: TDateTime);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsVariant(const NewValue: Variant);
begin
  Parameter.Value := NewValue;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetAsWord(Value: Integer);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetDataType(Value: TFieldType);
begin
  Parameter.DataType := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.SetText(const Value: string);
begin
  Parameter.Value := Value;
end;
//----------------------------------------------------------------------------------------
procedure TBoldACCParameter.AssignFieldValue(source: IBoldField);
begin
  Parameter.Assign(Source.Field);
end;
//****************************************************************************************
end.