unit uDAEngine;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Core 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.                        }
{----------------------------------------------------------------------------}

{$I DataAbstract.inc}

interface

uses
  Classes, DB, SysUtils,
  {$IFDEF MSWINDOWS} ActiveX, ComObj,{$ENDIF} // for ISupportErrorInfo, EOleSysError
  uDAInterfaces, uROClasses, uDARes, uROTypes, uDAMacros, uDAUtils;

type
  { Misc }
  TCustomConnectionClass = class of TCustomConnection;
  TDatasetClass = class of TDataset;
  TDAEConnection = class;
  TDAEDriver = class;

  { Exceptions }
  EDAException = class(EROException);
  EDADriverException = class(EDAException);

  { TDAConnectionWrapper
      Internal wrapper class for frameworks whose connections don't inherit from TCustomConnection or require additional
      supporting components. See IBO and DBISAM drivers for an example. This class provides an implementation for DoConnect
      and DoDisconnect removing the need to further override them. }
  TDAConnectionWrapper = class(TCustomConnection)
  protected
    procedure DoConnect; override;
    procedure DoDisconnect; override;
  end;

  {$IFDEF MSWINDOWS}
  TDAEngineBaseObject = class(TROInterfacedObject, ISupportErrorInfo)//, IServerExceptionHandler)
  protected
    function InterfaceSupportsErrorInfo(const iid: TGUID): HRESULT; stdcall;
    procedure OnException(const ServerClass: WideString; const ExceptionClass: WideString;
                          const ErrorMessage: WideString; ExceptAddr: Integer; const ErrorIID: WideString;
                          const ProgID: WideString; var Handled: Integer; var Result: HRESULT);
  public
    function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
  end;
  {$ELSE}
  TDAEngineBaseObject = TROInterfacedObject;
  {$ENDIF}


  { TDASQLMacroProcessor }
  TDASQLMacroProcessor = class(TROMacroParser)
  private
    fStoredProcedurePrefix,
      fDateFormat,
      fStoredProcParamPrefix,
      fDateTimeFormat: string;
    fDoubleQuoteStrings: boolean;
    function MyUnknownIdentifier(Sender: TObject; const Name, OrgName: string; var Value: string): Boolean;
  protected
    // Internal
    procedure RegisterMacros; virtual;

    // SQL Functions
    function DateTime(Sender: TObject; const Parameters: array of string): string; virtual; abstract;
    function Date(Sender: TObject; const Parameters: array of string): string; virtual;

    function AddTime(Sender: TObject; const Parameters: array of string): string; virtual; abstract;

    function FormatDateTime(Sender: TObject; const Parameters: array of string): string; virtual;
    function FormatDate(Sender: TObject; const Parameters: array of string): string; virtual;

    function Length(Sender: TObject; const Parameters: array of string): string; virtual; abstract;
    function LowerCase(Sender: TObject; const Parameters: array of string): string; virtual; abstract;
    function UpperCase(Sender: TObject; const Parameters: array of string): string; virtual; abstract;
    function TrimLeft(Sender: TObject; const Parameters: array of string): string; virtual; abstract;
    function TrimRight(Sender: TObject; const Parameters: array of string): string; virtual; abstract;
    function Copy(Sender: TObject; const Parameters: array of string): string; virtual; abstract;
    function Nolock(Sender: TObject; const Parameters: array of string): string; virtual;abstract;
  public
    constructor Create(const aDateFormat, aDateTimeFormat: string;
      aDoubleQuoteStrings: boolean;
      const aStoredProcParamsPrefix: string = '');overload;
    constructor Create;overload;

    property StoredProcedurePrefix: string read fStoredProcedurePrefix;
    property DateFormat: string read fDateFormat;
    property StoredProcParamPrefix: string read fStoredProcParamPrefix;
    property DateTimeFormat: string read fDateTimeFormat;
    property DoubleQuoteStrings: boolean read fDoubleQuoteStrings;
  end;

  IDAHasMacroProcessor = interface(IDAConnection)
    ['{C18B417F-C698-4BB1-8F57-C3952E1046D1}']
    function GetMacroProcessor: TDASQLMacroProcessor;
  end;

  { TDAESQLCommand }
  {$WARN SYMBOL_DEPRECATED OFF}
  TDAESQLCommand = class(TDAEngineBaseObject, IDASQLCommand, IDAMustSetParams)
  private
    fConnection: TDAEConnection;
    fDataset: TDataset;
    fParams: TDAParamCollection;
    fWhere: TDAWhere;
    fDynamicWhere: TDASQLWhereBuilder;
    fChanged: boolean;
    fSQL: string;
    fName: string;
    fPrepared: boolean;
    //fOrderBy : string;
    fOnAfterExecute: TDAAfterExecuteCommandEvent;
    fOnBeforeExecute: TDABeforeExecuteCommandEvent;
    fOnExecuteError: TDAExecuteCommandErrorEvent;
    FIsPresentDynWhereVariable: Boolean;
    function UnknownIdentifier(Sender: TObject; const Name, OrgName: string; var Value: string): Boolean;
    procedure SetDynamicWhereParams;
    procedure RemoveDynamicWhereParams;
  protected
    // Internal
    procedure OnWhereChange(Sender: TObject);
    procedure PrepareSQLStatement; virtual;
    function GenerateDynamicWhereStatement: string;
    function SQLContainsDynamicWhere: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetParamValuesStd(Params1: TDAParamCollection;Params2: TParams);
    procedure SetParamValuesStd(Params1: TDAParamCollection;Params2: TParams);
    procedure ClearParams; virtual; 
    function FindParameter(const AParams: TParams;const AParamName: string): TParam;

    // To be overridden
    function CreateDataset(aConnection: TDAEConnection): TDataset; virtual; abstract;

    procedure DoPrepare(Value: boolean); virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function DoExecute: integer; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} abstract;
    procedure DoSetSQL(const Value: string); virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} abstract;
    function DoGetSQL: string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}abstract;

    // IDASQLCommand
    function GetDataset: TDataset; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetPrepared: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetPrepared(Value: boolean); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetParams: TDAParamCollection; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure RefreshParams; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function Execute: integer; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetWhere: TDAWhere; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} deprecated;
    function GetDynamicWhere: TDAWhereBuilder; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetDynamicWhere(const Value: TDAWhereBuilder); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetSQL: string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetSQL(const Value: string); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetName: string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    function ParamByName(const aName: string): TDAParam; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    property Dataset: TDataset read GetDataset;
    property Changed: boolean read fChanged write fChanged;
    property Connection: TDAEConnection read fConnection;

    function GetOnAfterExecute: TDAAfterExecuteCommandEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetOnBeforeExecute: TDABeforeExecuteCommandEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnAfterExecute(const Value: TDAAfterExecuteCommandEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnBeforeExecute(const Value: TDABeforeExecuteCommandEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetOnExecuteError: TDAExecuteCommandErrorEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnExecuteError(const Value: TDAExecuteCommandErrorEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function intVCLTypeToDAType(aFieldType: TFieldType): TDADataType;virtual;
    procedure SetParamValues(AParams: TDAParamCollection); virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} abstract;
    procedure GetParamValues(AParams: TDAParamCollection); virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} abstract;
  public
    constructor Create(aConnection: TDAEConnection; const aName: string = ''); virtual;
    destructor Destroy; override;
  end;

  { TDAEDataset }
  TDAEDataset = class(TDAESQLCommand, IDASQLCommand, IDADataset)
  private
    fAutoFields: boolean;
    fFields: TDAFieldCollection;
    fLogicalName : string;
    fOnAfterOpen: TDAAfterOpenDatasetEvent;
    fOnBeforeOpen: TDABeforeOpenDatasetEvent;
    fOnOpenError: TDAOpenDatasetErrorEvent;

  protected
    function IsNeedToFixFMTBCDIssue: Boolean; virtual;
    procedure FixKnownIssues;virtual;
    procedure FixFMTBCDIssue;
    // To be overridden
    function DoGetRecordCount: integer; dynamic;
    function DoGetActive: boolean; dynamic;
    procedure DoSetActive(Value: boolean); dynamic;
    function DoGetBOF: boolean; dynamic;
    function DoGetEOF: boolean; dynamic;

    procedure DoNext; dynamic;

    function DoLocate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; dynamic;

    // IDADataset
    function GetRecordCount: integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetFieldCount: integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetFields: TDAFieldCollection; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetActive: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetActive(Value: boolean); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetBOF: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetEOF: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetFieldValues(Index: integer): Variant; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetNames(Index: integer): string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetIsEmpty : boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetState : TDatasetState; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    procedure Open; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure Close; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    procedure EnableControls; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure DisableControls; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function  ControlsDisabled: Boolean;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    procedure Next; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    procedure Refresh; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    function FieldByName(const aName: string): TDAField; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function FindField(const aName: string): TDAField; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    function GetBookMark: pointer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GotoBookmark(Bookmark: TBookmark); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure FreeBookmark(Bookmark: TBookmark); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetLogicalName : string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetLogicalName(aName : string); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    function GetOnAfterOpen: TDAAfterOpenDatasetEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetOnBeforeOpen: TDABeforeOpenDatasetEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnAfterOpen(const Value: TDAAfterOpenDatasetEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnBeforeOpen(const Value: TDABeforeOpenDatasetEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetOnOpenError: TDAOpenDatasetErrorEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnOpenError(const Value: TDAOpenDatasetErrorEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    function GetRowRecIdValue: integer;
    function GetCurrentRecIdValue: integer;
    procedure SetCurrentRecIdValue(Value: integer);
    procedure EnableConstraints; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure DisableConstraints; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
  public
    constructor Create(aConnection: TDAEConnection; const aName: string = ''); override;
    destructor Destroy; override;
  end;
  {$WARN SYMBOL_DEPRECATED ON}

  TDAEDatasetClass = class of TDAEDataset;

  {$WARN SYMBOL_DEPRECATED OFF}
  { TDAEStoredProcedure }
  TDAEStoredProcedure = class(TDAESQLCommand, IDASQLCommand, IDAStoredProcedure)
  private
  protected
    procedure RefreshParamsStd(AParams: TParams);
    // Internal
    procedure DoPrepare(Value: boolean); override;
    procedure RefreshParams; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    // IDAStoredProcedure
    function GetStoredProcedureName: string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} abstract;
    procedure SetStoredProcedureName(const Name: string); virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} abstract;
    procedure PrepareSQLStatement; override;
  public
  end;
  {$WARN SYMBOL_DEPRECATED ON}
  TDAEStoredProcedureClass = class of TDAEStoredProcedure;

  { TDAEConnection }
  TDAEConnection = class(TDAEngineBaseObject, IDAConnection, IDAConnectionObjectAccess, IDATestableObject, IDAHasMacroProcessor)
  private
    fConnectionObject: TCustomConnection;
    fConnectionString: string;
    fConnectionManager: IDAConnectionManager;
    fConnectionDefinition: TDAConnection;
    fDriver: TDAEDriver;
    fUserID,
    fPassword,
    fName: string;
    fMacroProcessor: TDASQLMacroProcessor;
    fOnAfterExecuteCommand: TDAAfterExecuteCommandEvent;
    fOnAfterOpenDataset: TDAAfterOpenDatasetEvent;
    fOnBeforeOpenDataset: TDABeforeOpenDatasetEvent;
    fOnBeforeExecuteCommand: TDABeforeExecuteCommandEvent;
    fOnExecuteCommandError: TDAExecuteCommandErrorEvent;
    fOnOpenDatasetError: TDAOpenDatasetErrorEvent;
    fConnectionPool: IDAConnectionPool;
    fReleasing: Boolean;
    fUseMacroProcessor:Boolean;

    function CreateConnectionObject: TCustomConnection;

  protected
    fConnectionType: string;
    property ConnectionName: string read fName;
    property ConnectionManager: IDAConnectionManager read fConnectionManager;
    property ConnectionDefinition: TDAConnection read fConnectionDefinition;

    function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
    function GetConnectionPool: IDAConnectionPool; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetConnectionPool(const Value: IDAConnectionPool); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    // To be overridden
    function CreateCustomConnection: TCustomConnection; virtual; abstract;
    function CreateMacroProcessor: TDASQLMacroProcessor; virtual;

    function GetDatasetClass: TDAEDatasetClass; virtual;
    function GetStoredProcedureClass: TDAEStoredProcedureClass; virtual;

    procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection); virtual;

    function DoBeginTransaction: integer; virtual; abstract;
    procedure DoCommitTransaction; virtual; abstract;
    procedure DoRollbackTransaction; virtual; abstract;
    function DoGetInTransaction: boolean; virtual; abstract;

    procedure DoGetTableNames(out List: IROStrings); virtual;
    procedure DoGetViewNames(out List: IROStrings); virtual;
    procedure DoGetStoredProcedureNames(out List: IROStrings); virtual;
    procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); virtual;
    procedure DoGetQueryFields(const aSQL: string; aParamsIfNeeded: TDAParamCollection; out Fields: TDAFieldCollection); virtual;
    procedure DoGetViewFields(const aViewName: string; out Fields: TDAFieldCollection); virtual;
    procedure DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection); virtual;
    procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); virtual;

    function DoGetLastAutoInc(const GeneratorName: string): integer; virtual;

    // Misc
    procedure ApplyConnectionString(const aConnectionString: string; aConnectionObject: TCustomConnection);

    procedure AssignCommandEventHandlers(const aCommand: IDASQLCommand);
    procedure AssignDatasetEventHandlers(const aDataset: IDADataset);

    // IDAConnectionObjectAccess
    function GetConnectionObject: TObject; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetConnectionProperties(const aPropertyName: string): Variant; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetConnectionProperties(const aPropertyName: string; const aValue: Variant); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    // IDATestableObject
    procedure Test; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    // IDAConnection
    function GetConnectionString: string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetConnectionString(Value: string); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetConnected: boolean; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetConnected(Value: boolean); virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetName: string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    function GetOnAfterExecuteCommand: TDAAfterExecuteCommandEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetOnAfterOpenDataset: TDAAfterOpenDatasetEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetOnBeforeExecuteCommand: TDABeforeExecuteCommandEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetOnBeforeOpenDataset: TDABeforeOpenDatasetEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetOnExecuteCommandError: TDAExecuteCommandErrorEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetOnOpenDatasetError: TDAOpenDatasetErrorEvent; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnAfterExecuteCommand(const Value: TDAAfterExecuteCommandEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnAfterOpenDataset(const Value: TDAAfterOpenDatasetEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnBeforeExecuteCommand(const Value: TDABeforeExecuteCommandEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnBeforeOpenDataset(const Value: TDABeforeOpenDatasetEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnExecuteCommandError(const Value: TDAExecuteCommandErrorEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetOnOpenDatasetError(const Value: TDAOpenDatasetErrorEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    procedure Open(const aUserID: string = ''; const aPassword: string = ''); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure Close; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    // UserID/Password
    function GetUserID: string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetUserID(const Value: string); virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetPassword: string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetPassword(const Value: string); virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    function BeginTransaction: integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure CommitTransaction; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure RollbackTransaction; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetInTransaction: boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    procedure GetTableNames(out List: IROStrings); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetViewNames(out List: IROStrings); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetStoredProcedureNames(out List: IROStrings); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetTableFields(const aTableName: string; out Fields: TDAFieldCollection); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetQueryFields(const aSQL: string; aParamsIfNeeded: TDAParamCollection; out Fields: TDAFieldCollection); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetViewFields(const aViewName: string; out Fields: TDAFieldCollection); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}


    function GetSPSelectSyntax(HasArguments: Boolean): string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetQuoteChars: TDAQuoteCharArray; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function IdentifierIsQuoted(const iIdentifier: string): boolean; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function IdentifierNeedsQuoting(const iIdentifier: string): boolean; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function QuoteIdentifierIfNeeded(const iIdentifier: string): string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function QuoteIdentifier(const iIdentifier: string): string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function QuoteFieldNameIfNeeded(const aTableName, aFieldName: string): string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function QuoteFieldName(const aTableName, aFieldName: string): string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    function NewCommand(const Text: string; CommandType: TDASQLStatementType; const aCommandName: string = ''): IDASQLCommand; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function NewDataset(const SQL: string; const aDatasetName: string = ''): IDADataset; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetLastAutoInc(const GeneratorName: string = ''): integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    property UserID: string read GetUserID write SetUserID;
    property Password: string read GetPassword write SetPassword;
    property ConnectionObject: TCustomConnection read fConnectionObject write fConnectionObject;
    function GetMacroProcessor: TDASQLMacroProcessor;
    function _Release: Integer; override; stdcall;
    function isAlive: Boolean; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetConnectionType: string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    property ConnectionType: string read GetConnectionType;
    function GetQueryBuilder: TDAQueryBuilder; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetWhereBuilder: TDASQLWhereBuilder; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetUseMacroProcessor: Boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure SetUseMacroProcessor(Value:Boolean); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
  public
    constructor Create(aDriver: TDAEDriver; aName: string = ''); virtual;
    destructor Destroy; override;

    property ConnectionPool: IDAConnectionPool read GetConnectionPool write SetConnectionPool;
    property Driver: TDAEDriver read fDriver;
    property MacroProcessor: TDASQLMacroProcessor read GetMacroProcessor;
  end;

  TDAEConnectionClass = class of TDAEConnection;

  { TDAEDriver }
  TDAEDriver = class(TComponent, IDADriver, IDADriver30)
  private

  protected
    // To be overridden
    function GetConnectionClass: TDAEConnectionClass; virtual; abstract;
    procedure CustomizeConnectionObject(aConnection: TDAEConnection); dynamic;
    procedure DoSetTraceOptions(TraceActive: boolean; TraceFlags: TDATraceOptions; Callback: TDALogTraceEvent); virtual;

    { IDADriver }
    function GetDriverID: string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} abstract;
    function GetDescription: string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} abstract;
    function GetMajVersion: byte; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetMinVersion: byte; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    procedure GetAuxDrivers(out List: IROStrings); virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetDefaultConnectionType(const AuxDriver: string): string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    procedure SetTraceOptions(TraceActive: boolean; TraceFlags: TDATraceOptions; Callback: TDALogTraceEvent); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    function NewConnection(const aName: string = ''; const aConnectionType: string = ''): IDAConnection; overload; {deprecated;} {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function NewConnection(const aConnectionManager: IDAConnectionManager; aConnectionDefinition: TDAConnection): IDAConnection; overload; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    procedure Initialize; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure Finalize; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    function GetAvailableDriverOptions: TDAAvailableDriverOptions; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function GetDefaultCustomParameters: string; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}

    { IDADriver30 }
    function GetDriverHelp(aType: TDADriverHelpType): string;
  public
    destructor Destroy; override;
  end;

  TDAEDriverClass = class of TDAEDriver;

  { TDADriverReference }
  TDADriverReference = class(TComponent)
  end;

{$IFDEF MSWINDOWS}
function DAHandleSafeCallException(aObject:TObject; ExceptObject: TObject; ExceptAddr: Pointer): HResult;
{$ENDIF MSWINDOWS}
function Engine_GetDatabaseNames(aConnection:TDAEConnection; aMasterDatabase, aGetDatabaseNamesSQL: String): IROStrings;

implementation

uses
  {$IFDEF MSWINDOWS}Windows,{$ENDIF} Variants,{$IFDEF FPC}dbconst,{$ELSE}DBConsts,{$ENDIF}
  TypInfo, uDAHelpers, uROClient, uDASQL92QueryBuilder, uROBinaryHelpers;

function Engine_GetDatabaseNames(aConnection:TDAEConnection; aMasterDatabase, aGetDatabaseNamesSQL: String): IROStrings;
var
  connStrParser             : TDAConnectionStringParser;
  conn                      : IDAConnection;
  ds                        : IDAdataset;
begin
  Result := NewROStrings;
  connStrParser := TDAConnectionStringParser.Create((aConnection as IDAConnection).ConnectionString);
  try
    connStrParser.Database := aMasterDatabase;

    conn := TDAEConnectionClass(aConnection.ClassType).Create(aConnection.Driver);
    conn.ConnectionString := connStrParser.BuildString;
    conn.Open;

    ds := conn.NewDataset(aGetDatabaseNamesSQL);
    ds.Open;

    while not ds.EOF do begin
      result.Add(VarToStr(ds.FieldValues[0]));
      ds.Next;
    end;
  finally
    connStrParser.Free;
    conn := nil;
    ds := nil;
  end;
end;

{ TDAEDriver }

destructor TDAEDriver.Destroy;
begin
  SetTraceOptions(FALSE, [], nil);

  inherited;
end;

procedure TDAEDriver.Initialize;
begin
end;

procedure TDAEDriver.Finalize;
begin

end;

function TDAEDriver.GetMajVersion: byte;
begin
  result := 1
end;

function TDAEDriver.GetMinVersion: byte;
begin
  result := 0
end;

function TDAEDriver.NewConnection(const aName: string = '';const aConnectionType: string = ''): IDAConnection;
var
  conn: TDAEConnection;
begin
  conn := GetConnectionClass.Create(Self, aName);
  conn.FConnectionType := aConnectionType;
  CustomizeConnectionObject(conn); // In some cases the driver might need to do additional customization

  result := conn;
end;

function TDAEDriver.NewConnection(const aConnectionManager: IDAConnectionManager; aConnectionDefinition: TDAConnection): IDAConnection;
var
  conn: TDAEConnection;
begin
  conn := GetConnectionClass.Create(Self, aConnectionDefinition.Name);
  conn.fConnectionType := aConnectionDefinition.ConnectionType;
  conn.fConnectionManager := aConnectionManager;
  conn.fConnectionDefinition := aConnectionDefinition;
  CustomizeConnectionObject(conn); // In some cases the driver might need to do additional customization

  result := conn;
end;

function TDAEDriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
begin
  //result := [doAuxDriver,doServerName,doDatabaseName,doLogin,doCustom];
  result := [doServerName, doDatabaseName, doLogin];
end;

function TDAEDriver.GetDefaultConnectionType(const AuxDriver: string): string;
begin
  result := '';
end;

function TDAEDriver.GetDefaultCustomParameters: string;
begin
  result := '';
end;

procedure TDAEDriver.SetTraceOptions(TraceActive: boolean; TraceFlags: TDATraceOptions; Callback: TDALogTraceEvent);
begin
  if (csDesigning in ComponentState) then Exit;

  DoSetTraceOptions(TraceActive, TraceFlags, Callback);
end;

procedure TDAEDriver.CustomizeConnectionObject(aConnection: TDAEConnection);
begin
end;

procedure TDAEDriver.DoSetTraceOptions(TraceActive: boolean;
  TraceFlags: TDATraceOptions; Callback: TDALogTraceEvent);
begin
end;

procedure TDAEDriver.GetAuxDrivers(out List: IROStrings);
begin
  List := NewROStrings();
end;

procedure TDAEDriver.GetAuxParams(const AuxDriver: string; out List: IROStrings);
begin
  List := NewROStrings();
end;

function TDAEDriver.GetDriverHelp(aType: TDADriverHelpType): string;
begin
  result := LoadHtmlFromResource(hInstance, 'DRIVER_HELP');
end;

{ TDAEConnection }

constructor TDAEConnection.Create(aDriver: TDAEDriver; aName: string = '');
begin
  inherited Create;

  fName := aName;
  fDriver := aDriver;
  fConnectionObject := CreateConnectionObject;
  FUseMacroProcessor := True;
end;

destructor TDAEConnection.Destroy;
begin
  if Assigned(fConnectionObject) then begin
    try
      if fConnectionObject.Connected then fConnectionObject.Close;
    except
    end;  
    FreeAndNIL(fConnectionObject);
  end;

  if Assigned(fMacroProcessor) then fMacroProcessor.Free;

  inherited;
end;

function TDAEConnection.GetConnected: boolean;
begin
  result := assigned(fConnectionObject) and fConnectionObject.Connected;
end;

function TDAEConnection.GetConnectionString: string;
begin
  result := fConnectionString;
end;

procedure TDAEConnection.SetConnected(Value: boolean);
begin
  if fConnectionObject <> nil then
    fConnectionObject.Connected := Value;
end;

procedure TDAEConnection.SetConnectionString(Value: string);
begin
  if (Value = fConnectionString) then Exit;

  ApplyConnectionString(Value, fConnectionObject);
end;

function TDAEConnection.GetConnectionObject: TObject;
begin
  result := fConnectionObject;
end;

function TDAEConnection.GetConnectionProperties(
  const aPropertyName: string): Variant;
begin
  if assigned(fConnectionObject) then
    result := GetPropValue(fConnectionObject, aPropertyName, FALSE)
  else
    result := Unassigned;
end;

procedure TDAEConnection.SetConnectionProperties(
  const aPropertyName: string; const aValue: Variant);
begin
  if assigned(fConnectionObject) then
    SetPropValue(fConnectionObject, aPropertyName, aValue);
end;

procedure TDAEConnection.Close;
begin
  SetConnected(FALSE); // Exceptions are handled there
end;

procedure TDAEConnection.Open(const aUserID: string = ''; const aPassword: string = '');
begin
  if (aUserID <> '') then UserID := aUserID;
  if (aPassword <> '') then Password := aPassword;

  SetConnected(TRUE); // Exceptions are handled there
end;

function TDAEConnection.CreateConnectionObject: TCustomConnection;
begin
  result := CreateCustomConnection;
end;

function TDAEConnection.NewDataset(const SQL: string; const aDatasetName: string = ''): IDADataset;
begin
  result := GetDatasetClass.Create(Self, aDatasetName);
  result.SQL := SQL;

  AssignDatasetEventHandlers(result); // Propagates the event handlers to all datasets
end;

function TDAEConnection.NewCommand(const Text: string; CommandType: TDASQLStatementType; const aCommandName: string = ''): IDASQLCommand;
var
  sp: IDAStoredProcedure;
  ds: IDADataset;
begin
  result := nil;

  case CommandType of
    stStoredProcedure: begin
        sp := GetStoredProcedureClass.Create(Self, aCommandName);
        sp.StoredProcedureName := Text;

        result := sp;
      end;
    stSQL: begin
        ds := GetDatasetClass.Create(Self, aCommandName);
        ds.SQL := Text;
        result := ds;
      end;
  end;

  if Result <> nil then
    Result.RefreshParams;

  AssignCommandEventHandlers(result); // Propagates the event handlers to all commands
end;

function TDAEConnection.BeginTransaction: integer;
begin
  result := -1;

  DoBeginTransaction;
end;

procedure TDAEConnection.CommitTransaction;
begin
  DoCommitTransaction;
end;

procedure TDAEConnection.RollbackTransaction;
begin
  DoRollbackTransaction;
end;

procedure TDAEConnection.GetStoredProcedureNames(out List: IROStrings);
begin
  DoGetStoredProcedureNames(List);
end;

procedure TDAEConnection.GetStoredProcedureParams(
  const aStoredProcedureName: string; out Params: TDAParamCollection);
begin
  DoGetStoredProcedureParams(aStoredProcedureName, Params);
end;

procedure TDAEConnection.GetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection);
begin
  DoGetForeignKeys(ForeignKeys);
end;

procedure TDAEConnection.GetTableFields(const aTableName: string;
  out Fields: TDAFieldCollection);
begin
  DoGetTableFields(aTableName, Fields);
end;

procedure TDAEConnection.GetQueryFields(const aSQL: string; aParamsIfNeeded: TDAParamCollection; out Fields: TDAFieldCollection);
begin
  DoGetQueryFields(aSQL, aParamsIfNeeded, Fields);
end;

procedure TDAEConnection.GetTableNames(out List: IROStrings);
begin
  DoGetTableNames(List);
end;

procedure TDAEConnection.GetViewFields(const aViewName: string;
  out Fields: TDAFieldCollection);
begin
  DoGetViewFields(aViewName, Fields);
end;

procedure TDAEConnection.GetViewNames(out List: IROStrings);
begin
  DoGetViewNames(List);
end;

function TDAEConnection.GetWhereBuilder: TDASQLWhereBuilder;
begin
  Result:= TDASQL92WhereBuilder.Create(Self);
end;

function TDAEConnection.GetDatasetClass: TDAEDatasetClass;
begin
  result := nil;
end;

function TDAEConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
begin
  result := nil;
end;

procedure TDAEConnection.DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection);
var
  qry: IDADataset;
begin
  Fields := TDAFieldCollection.Create(nil);
  qry := GetDatasetClass.Create(Self);
  try
    qry.SQL := 'SELECT * FROM ' + QuoteIdentifierIfNeeded(aTableName) + ' WHERE 1=0';
    qry.Open;
    Fields.Assign(qry.Fields);
  finally
    qry := nil;
  end;
end;

procedure TDAEConnection.DoGetQueryFields(const aSQL: string; aParamsIfNeeded: TDAParamCollection; out Fields: TDAFieldCollection);
var
  qry: IDADataset;
begin
  Fields := TDAFieldCollection.Create(nil);
  qry := GetDatasetClass.Create(Self);
  try
    qry.SQL := aSQL;
    if assigned(aParamsIfNeeded) then
      qry.Params.AssignParamCollection(aParamsIfNeeded);
    qry.Open;
    Fields.Assign(qry.Fields);
  finally
    qry := nil;
  end;
end;

procedure TDAEConnection.DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection);
var
  cmd: IDASQLCommand;
begin
  //Params := nil;
  cmd := NewCommand(aStoredProcedureName, stStoredProcedure);
  cmd.RefreshParams;

  {if (Params = nil) then} Params := TDAParamCollection.Create(nil);
  Params.AssignParamCollection(cmd.Params);
end;

procedure TDAEConnection.DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection);
begin
  ForeignKeys := TDADriverForeignKeyCollection.Create(nil);
end;

function TDAEConnection.GetName: string;
begin
  result := fName;
end;

procedure TDAEConnection.DoGetViewFields(const aViewName: string;
  out Fields: TDAFieldCollection);
begin
  DoGetTableFields(aViewName, Fields);
end;

function TDAEConnection.GetQuoteChars: TDAQuoteCharArray;
begin
  result[0] := '"';
  result[1] := '"';
end;

procedure TDAEConnection.DoGetViewNames(out List: IROStrings);
begin
  List := NewROStrings; // Changed from NIL.
end;

procedure TDAEConnection.DoGetStoredProcedureNames(out List: IROStrings);
begin
  List := NewROStrings; // Changed from NIL.
end;

procedure TDAEConnection.DoGetTableNames(out List: IROStrings);
begin
  List := NewROStrings; // Changed from NIL.
end;

function TDAEConnection.GetInTransaction: boolean;
begin
  result := DoGetInTransaction;
end;

function TDAEConnection.GetPassword: string;
begin
  result := fPassword;
end;

function TDAEConnection.GetUserID: string;
begin
  result := fUserID;
end;

procedure TDAEConnection.SetPassword(const Value: string);
begin
  fPassword := Value;

  ApplyConnectionString(GetConnectionString, ConnectionObject); // Refreshes it
end;

procedure TDAEConnection.SetUserID(const Value: string);
begin
  fUserID := Value;

  ApplyConnectionString(GetConnectionString, ConnectionObject); // Refreshes it
end;

function TDAEConnection.GetLastAutoInc(
  const GeneratorName: string): integer;
begin
  result := DoGetLastAutoInc(GeneratorName);
end;

function TDAEConnection.DoGetLastAutoInc(
  const GeneratorName: string): integer;
begin
  result := -1;
end;

function TDAEConnection.IdentifierIsQuoted(const iIdentifier: string): boolean;
var
  lQuoteChars: TDAQuoteCharArray;
  lLength:integer;
begin
  lQuoteChars := GetQuoteChars();
  lLength := Length(iIdentifier);
  result := (lLength > 2) and (iIdentifier[1] = lQuoteChars[0]) and (iIdentifier[lLength] = lQuoteChars[1]);
end;

function TDAEConnection.IdentifierNeedsQuoting(const iIdentifier: string): boolean;
var
  i: integer;
begin
  result := false;
  if IdentifierIsQuoted(iIdentifier) then Exit;

  for i := 1 to Length(iIdentifier) do begin
    if not (iIdentifier[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '.']) then begin
      result := true;
      exit;
    end;
  end;
  if (iIdentifier <> '') then begin
    i := pos('.',iIdentifier);
    if (i < Length(iIdentifier)) and (iIdentifier[i+1] in ['0'..'9']) then Result := True;
  end;
end;

function TDAEConnection.QuoteIdentifierIfNeeded(const iIdentifier: string): string;
begin
  if IdentifierNeedsQuoting(iIdentifier) then
    result := QuoteIdentifier(iIdentifier)
  else
    result := iIdentifier;
end;

function TDAEConnection.QuoteIdentifier(const iIdentifier: string): string;
var
  lQuoteChars: TDAQuoteCharArray;
begin
  lQuoteChars := GetQuoteChars();
  if (Pos('.', iIdentifier)>0) then
    result := lQuoteChars[0] + StringReplace(iIdentifier, '.', lQuoteChars[1]+'.'+ lQuoteChars[0], [rfReplaceAll]) + lQuoteChars[1]
  else
    result := lQuoteChars[0] + iIdentifier + lQuoteChars[1];
end;

function TDAEConnection.CreateMacroProcessor: TDASQLMacroProcessor;
begin
{$WARNINGS OFF}
  result := TDASQLMacroProcessor.Create;
{$WARNINGS ON}
end;

procedure TDAEConnection.ApplyConnectionString(
  const aConnectionString: string; aConnectionObject: TCustomConnection);
var
  i: Integer;
  lParamName: String;
  lConnStrParser: TDAConnectionStringParser;
begin
  FreeAndNIL(fMacroProcessor);

  lConnStrParser := TDAConnectionStringParser.Create(aConnectionString);
  try
    fConnectionString := aConnectionString;
    DoApplyConnectionString(lConnStrParser, aConnectionObject);
    //with lConnStrParser do
    if aConnectionObject <> nil then
    begin
      for i := 0 to lConnStrParser.AuxParamsCount - 1 do begin
        lParamName := lConnStrParser.AuxParamNames[i];
        if Assigned(GetPropInfo(aConnectionObject, lParamName)) then begin
          SetConnectionProperties(lParamName, lConnStrParser.AuxParams[lParamName]);
        end;
      end;
    end;
  finally
    lConnStrParser.Free;
  end;

  fMacroProcessor := CreateMacroProcessor;
end;

procedure TDAEConnection.DoApplyConnectionString(
  aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
begin
  if (aConnectionObject <> nil) then aConnectionObject.Close;
end;

function TDAEConnection.GetOnAfterExecuteCommand: TDAAfterExecuteCommandEvent;
begin
  result := fOnAfterExecuteCommand
end;

function TDAEConnection.GetOnAfterOpenDataset: TDAAfterOpenDatasetEvent;
begin
  result := fOnAfterOpenDataset
end;

function TDAEConnection.GetOnBeforeExecuteCommand: TDABeforeExecuteCommandEvent;
begin
  result := fOnBeforeExecuteCommand
end;

function TDAEConnection.GetOnBeforeOpenDataset: TDABeforeOpenDatasetEvent;
begin
  result := fOnBeforeOpenDataset
end;

function TDAEConnection.GetOnExecuteCommandError: TDAExecuteCommandErrorEvent;
begin
  result := fOnExecuteCommandError
end;

function TDAEConnection.GetOnOpenDatasetError: TDAOpenDatasetErrorEvent;
begin
  result := fOnOpenDatasetError
end;

procedure TDAEConnection.SetOnAfterExecuteCommand(
  const Value: TDAAfterExecuteCommandEvent);
begin
  fOnAfterExecuteCommand := Value;
end;

procedure TDAEConnection.SetOnAfterOpenDataset(
  const Value: TDAAfterOpenDatasetEvent);
begin
  fOnAfterOpenDataset := Value;
end;

procedure TDAEConnection.SetOnBeforeExecuteCommand(
  const Value: TDABeforeExecuteCommandEvent);
begin
  fOnBeforeExecuteCommand := Value;
end;

procedure TDAEConnection.SetOnBeforeOpenDataset(
  const Value: TDABeforeOpenDatasetEvent);
begin
  fOnBeforeOpenDataset := Value;
end;

procedure TDAEConnection.SetOnExecuteCommandError(
  const Value: TDAExecuteCommandErrorEvent);
begin
  fOnExecuteCommandError := Value;
end;

procedure TDAEConnection.SetOnOpenDatasetError(
  const Value: TDAOpenDatasetErrorEvent);
begin
  fOnOpenDatasetError := Value;
end;

procedure TDAEConnection.AssignCommandEventHandlers(
  const aCommand: IDASQLCommand);
begin
  if aCommand=NIL then Exit;
  aCommand.OnBeforeExecute := fOnBeforeExecuteCommand;
  aCommand.OnAfterExecute := fOnAfterExecuteCommand;
  aCommand.OnExecuteError := fOnExecuteCommandError;
end;

procedure TDAEConnection.AssignDatasetEventHandlers(
  const aDataset: IDADataset);
begin
  if aDataset=NIL then Exit;
  aDataset.OnBeforeOpen := fOnBeforeOpenDataset;
  aDataset.OnAfterOpen := fOnAfterOpenDataset;
  aDataset.OnOpenError := fOnOpenDatasetError;
end;

procedure TDAEConnection.Test;
begin
  Open;
  Close;
end;

function TDAEConnection.GetSPSelectSyntax(HasArguments: Boolean): string;
begin
  Result := 'EXEC {0} {1}';
end;

function TDAEConnection.GetMacroProcessor: TDASQLMacroProcessor;
begin
  if FUseMacroProcessor then
    result := fMacroProcessor
  else
    Result := nil;
end;

function TDAEConnection._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if (Result = 0) and not (fReleasing) then begin
    fReleasing := True;
    InterlockedIncrement(fRefCount);
    if assigned(fConnectionPool) then
      fConnectionPool.ReleaseConnection(self);
    Result := InterlockedDecrement(fRefCount);
    fReleasing := False;
  end;
  if Result = 0 then
    Destroy;
end;

function TDAEConnection.GetConnectionPool: IDAConnectionPool;
begin
  result := fConnectionPool;
end;

procedure TDAEConnection.SetConnectionPool(const Value: IDAConnectionPool);
begin
  fConnectionPool := Value;
end;

function TDAEConnection.QuoteFieldName(const aTableName,
  aFieldName: string): string;
begin
  Result:= QuoteIdentifier(aFieldName);
end;

function TDAEConnection.QuoteFieldNameIfNeeded(const aTableName,
  aFieldName: string): string;
begin
  if IdentifierNeedsQuoting(aFieldName) then
    result := QuoteFieldName(aTableName,aFieldName)
  else
    result := aFieldName;
end;

function TDAEConnection.isAlive: Boolean;
begin
  Result:= (ConnectionObject <> nil) and ConnectionObject.Connected;
end;

function TDAEConnection.GetConnectionType: string;
begin
  Result:= FConnectionType;
end;

function TDAEConnection.GetQueryBuilder: TDAQueryBuilder;
begin
  Result:= TDASQL92QueryBuilder.Create;
  Result.Connection:=Self;
end;

function TDAEConnection.GetUseMacroProcessor: Boolean;
begin
  Result := FUseMacroProcessor;
end;

procedure TDAEConnection.SetUseMacroProcessor(Value: Boolean);
begin
  FUseMacroProcessor := Value;
end;

function TDAEConnection.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  Result:= E_NOINTERFACE;
  if IsEqualGUID(IID, IDAHasMacroProcessor) then begin
    if not FUseMacroProcessor then Exit;
  end;
  Result := inherited QueryInterface(IID, Obj)
end;

{ TDAEDataset }

constructor TDAEDataset.Create(aConnection: TDAEConnection; const aName: string = '');
begin
  inherited;

  fLogicalName := aName;
  if (fLogicalName='')
    then fLogicalName := NewGuidAsString;

  fChanged := true;
  fFields := TDAFieldCollection.Create(nil);
  {$WARN SYMBOL_DEPRECATED OFF}
  GetWhere.Fields := fFields; // So it can find the mappings!
  {$WARN SYMBOL_DEPRECATED ON}
end;

destructor TDAEDataset.Destroy;
begin
  FreeAndNil(fDataset);
  FreeAndNil(fFields);
  FreeAndNil(fWhere);

  inherited;
end;

function TDAEDataset.GetActive: boolean;
begin
  result := DoGetActive
end;

function TDAEDataset.GetBOF: boolean;
begin
  result := DoGetBOF
end;

function TDAEDataset.GetEOF: boolean;
begin
  result := DoGetEOF;
end;

function TDAEDataset.GetFieldCount: integer;
begin
  result := fFields.Count;
end;

function TDAEDataset.GetRecordCount: integer;
begin
  result := DoGetRecordCount;
end;

function TDAEDataset.Locate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
  result := DoLocate(KeyFields, KeyValues, Options);
end;

procedure TDAEDataset.Next;
begin
  DoNext;
end;

procedure TDAEDataset.Open;
begin
  SetActive(TRUE); // Handles the exception there
end;

procedure TDAEDataset.Close;
begin
  SetActive(FALSE); // Handles the exception there
end;

procedure TDAEDataset.SetActive(Value: boolean);
begin
  DoSetActive(Value);
end;

function TDAEDataset.GetFields: TDAFieldCollection;
begin
  result := fFields
end;

function TDAEDataset.DoGetActive: boolean;
begin
  result := fDataset.Active
end;

function TDAEDataset.DoGetBOF: boolean;
begin
  result := fDataset.BOF
end;

function TDAEDataset.DoGetEOF: boolean;
begin
  result := fDataset.EOF
end;

function TDAEDataset.DoGetRecordCount: integer;
begin
  result := fDataset.RecordCount
end;

function TDAEDataset.DoLocate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
begin
  result := fDataset.Locate(KeyFields, KeyValues, Options);
end;

procedure TDAEDataset.DoNext;
begin
  fDataset.Next
end;

procedure TDAEDataset.DoSetActive(Value: boolean);
var
  i: integer;
  fld: TField;
  startTick: Cardinal;
  s: string;
begin
  if (Value = GetActive) then Exit;

  // Opens the dataset
  if Value then begin
    // Combines the custom WHERE statement and modifies the inner SQL
    if fChanged or (fWhere.Changed) then PrepareSQLStatement;

    if Assigned(fConnection.fMacroProcessor) then begin
      i := fConnection.fMacroProcessor.IndexOfName('Where');
      s := GenerateDynamicWhereStatement;
      if i = -1 then
        fConnection.fMacroProcessor.AddVariable('Where').Value:=s
      else
        fConnection.fMacroProcessor.Variable[i].Value:=s;

      SetDynamicWhereParams;
      SetSQL(fConnection.fMacroProcessor.Eval(GetSQL));
    end;


    // Writes the parameter values
    if (fParams.Count > 0) then SetParamValues(fParams) else ClearParams;

    startTick := ROGetTickCount;
    if Assigned(fOnBeforeOpen) then fOnBeforeOpen(Self);
    // Opens the dataset
    fAutoFields := (fFields.Count = 0);
    try
      fDataset.Open;
      FixKnownIssues;
    except
      on E:Exception do begin
        if Assigned(fOnOpenError) then fOnOpenError(Self, DoGetSQL, E);
        raise;
      end;
    end;

    if Assigned(fOnAfterOpen) then fOnAfterOpen(Self, DoGetSQL, ROGetTickCount-startTick);

    GetParamValues(fParams);

    RemoveDynamicWhereParams;

    if fAutoFields and (fFields.Count = 0)then begin
      for i := 0 to (fDataset.FieldCount - 1) do begin
        fld := fDataset.Fields[i];
        with fFields.Add(fld.FieldName, intVCLTypeToDAType(fld.DataType), fld.Size) do begin
          if DataType = datDecimal then begin
            case fld.DataType of
              {$IFNDEF FPC}
              ftFMTBcd: begin
                DecimalPrecision:= TFMTBCDField(fld).Precision;
                DecimalScale:= TFMTBCDField(fld).Size;
              end;
              {$ENDIF}
              ftBCD: begin
                DecimalPrecision:= TBCDField(fld).Precision;
                DecimalScale:= TBCDField(fld).Size;
              end;
            else
              DataType := datFloat;
            end;
          end;
          // Fix ZEOS issue
          {$IFDEF DELPHI2006UP}
          if (DataType = datWideString) and (Size = MaxInt div 2) then begin
            DataType:= datWideMemo;
            Size := 0;
          end;
          {$ENDIF}
          Bind(fld);
        end;
      end;
    end
    else
      fFields.Bind(fDataset);
  end
  else begin
    if fAutoFields then
      fFields.Clear
    else
      fFields.Unbind;

    fDataset.Close;
  end;
end;

function TDAEDataset.GetFieldValues(Index: integer): Variant;
begin
  With fFields[Index] do
    if (BindedField = nil) or (BindedField.IsNull) then
      Result:=Null
    else
      case BindedField.DataType of
        ftTimeStamp: result := BindedField.AsDateTime;
        {$IFNDEF FPC}
        // FPC doesn't support ftFMTBcd
        ftFMTBcd: Result:= BCDToVariant(BindedField.AsBCD,True);
        {$ENDIF}
        ftBytes: Result := BindedField.Value;
      else
        result := fFields[Index].Value;
      end;
end;

function TDAEDataset.GetNames(Index: integer): string;
begin
  result := fDataset.Fields[Index].Name
end;

procedure TDAEDataset.DisableControls;
begin
  fDataset.DisableControls
end;

procedure TDAEDataset.EnableControls;
begin
  fDataset.EnableControls
end;

function TDAEDataset.FieldByName(const aName: string): TDAField;
begin
  result := fFields.FieldByName(aName) as TDAField;
end;

procedure TDAEDataset.FreeBookmark(Bookmark: TBookmark);
begin
  Dataset.FreeBookmark(Bookmark);
end;

function TDAEDataset.GetBookMark: pointer;
begin
  result := Dataset.GetBookmark
end;

procedure TDAEDataset.GotoBookmark(Bookmark: TBookmark);
begin
  Dataset.GotoBookmark(Bookmark);
end;

procedure TDAEDataset.Refresh;
begin

end;

function TDAEDataset.GetIsEmpty: boolean;
begin
  result := fDataset.IsEmpty
end;

function TDAEDataset.GetState: TDatasetState;
begin
  result := fDataset.State
end;

function TDAEDataset.Lookup(const KeyFields: string;
  const KeyValues: Variant; const ResultFields: string): Variant;
begin
  result := fDataset.Lookup(KeyFields, KeyValues, ResultFields);
end;

function TDAEDataset.GetLogicalName: string;
begin
  result := fLogicalName;
end;

function TDAEDataset.FindField(const aName: string): TDAField;
begin
  result := fFields.FindField(aName) as TDAField;
end;

procedure TDAEDataset.SetLogicalName(aName: string);
begin
  fLogicalName := aName
end;

function TDAEDataset.GetOnAfterOpen: TDAAfterOpenDatasetEvent;
begin
  result := fOnAfterOpen
end;

function TDAEDataset.GetOnBeforeOpen: TDABeforeOpenDatasetEvent;
begin
  result := fOnBeforeOpen
end;

procedure TDAEDataset.SetOnAfterOpen(
  const Value: TDAAfterOpenDatasetEvent);
begin
  fOnAfterOpen := Value
end;

procedure TDAEDataset.SetOnBeforeOpen(
  const Value: TDABeforeOpenDatasetEvent);
begin
  fOnBeforeOpen := Value
end;

function TDAEDataset.GetOnOpenError: TDAOpenDatasetErrorEvent;
begin
  result := fOnOpenError;
end;

procedure TDAEDataset.SetOnOpenError(
  const Value: TDAOpenDatasetErrorEvent);
begin
  fOnOpenError := Value;
end;

function TDAEDataset.GetCurrentRecIdValue: integer;
begin
  result := -1;
end;

procedure TDAEDataset.SetCurrentRecIdValue(Value: integer);
begin

end;

function TDAEDataset.GetRowRecIdValue: integer;
begin
  result := -1
end;

procedure TDAEDataset.DisableConstraints;
begin
  // do nothing
end;

procedure TDAEDataset.EnableConstraints;
begin
  // do nothing
end;

{
procedure TDAEDataset.CreateFieldDefs;
var
  i: integer;
  fld: TFieldDef;
  dafld: TDAField;
  lNeedtoCreateFieldDefs: Boolean;
  lFMTBCDPresent: Boolean;
begin
  lNeedtoCreateFieldDefs:=fDataset.FieldDefs.Count=0;
  lFMTBCDPresent:=False;
  // Adds the data fields (non calculated) to the FieldDefs
  for i := 0 to (fFields.Count - 1) do begin
    dafld:=fFields[i];
    if dafld.Calculated or dafld.Lookup then Continue; // Added as fields later
    if lNeedtoCreateFieldDefs then begin
      fld := fDataset.FieldDefs.AddFieldDef;
      fld.Name := dafld.Name;
      fld.DataType := DATypeToVCLType(dafld.DataType);
    end
    else begin
      fld := TFieldDef(fDataset.FieldDefs.Find(dafld.Name));
    end;

    // (autoinc)
    if (dafld.DataType=datLargeAutoInc) then fld.DataType := ftLargeint
    else if (dafld.DataType=datAutoInc) then fld.DataType := ftInteger;

    if (fld.DataType = ftString) or (fld.DataType = ftWideString) then fld.Size := dafld.Size;
    if (fld.DataType = ftGuid) then fld.Size := 38;
    if (fld.DataType = ftFMTBcd) then begin
      fld.Size:=dafld.DecimalScale;
      fld.Precision:=dafld.DecimalPrecision;
      lFMTBCDPresent:= True;
    end;
  end;
  if not lFMTBCDPresent then fDataset.FieldDefs.Clear;
  // Creates the data fields
  for i := 0 to (fDataset.FieldDefs.Count - 1) do
    fDataset.FieldDefs[i].CreateField(fDataset).DataSet := fDataset;
end;
}
function TDAEDataset.IsNeedToFixFMTBCDIssue: Boolean;
begin
  Result:= False;
end;

procedure TDAEDataset.FixFMTBCDIssue;
{$IFNDEF FPC}
var
  i: integer;
  lNeedToFix: Boolean;
  fld: TFieldDef;
  dafld: TDAField;
{$ENDIF}
begin
{$IFNDEF FPC}
// FPC doesn't support ftFMTBcd
  lNeedToFix:= False;
  for i:=0 to fDataset.Fields.Count-1 do
    if (fDataset.Fields[i].DataType = ftFMTBcd) and
       (TFMTBCDField(fDataset.Fields[i]).Precision=15) and
       (TFMTBCDField(fDataset.Fields[i]).Size=4) then begin
      lNeedToFix:=True;
      Break;
    end;
  if not lNeedToFix then Exit;
  fDataset.Close;
  for i := 0 to (fDataset.FieldDefs.Count - 1) do begin
    fld := fDataset.FieldDefs[i];
    if (fld.DataType = ftFMTBcd) then begin
      dafld:= fFields.FindField(fld.Name);
       if (fld.Precision = 15 ) and (fld.Size=4) then begin
        if (dafld <> nil) and (dafld.DataType = datDecimal) then begin
          fld.Precision := dafld.DecimalPrecision;
          fld.Size := dafld.DecimalScale;
        end else begin
          fld.Precision := 24;
          fld.Size := 8;
        end;
      end;
    end;
  end;
  fDataset.Open;
{$ENDIF}
end;

procedure TDAEDataset.FixKnownIssues;
begin
  if IsNeedToFixFMTBCDIssue then FixFMTBCDIssue;
end;

function TDAEDataset.ControlsDisabled: Boolean;
begin
  Result := fDataset.ControlsDisabled;
end;

{ TDAESQLCommand }

constructor TDAESQLCommand.Create(aConnection: TDAEConnection; const aName: string = '');
var
  id: TGUID;
begin
  inherited Create;

  fName := aName;
  if (fName = '') then begin
    CreateGUID(id);
    fName := GUIDToString(id);
  end;

  fWhere := TDAWhere.Create(nil, FALSE);
  fDynamicWhere:= nil;// aConnection.GetWhereBuilder;
  fConnection := aConnection;
  fParams := TDAParamCollection.Create(nil);
  fDataset := CreateDataset(fConnection);
end;

destructor TDAESQLCommand.Destroy;
begin
  fDataset.Free;
  fParams.Free;
  fWhere.Free;
  fDynamicWhere.Free;

  inherited;
end;

function TDAESQLCommand.GetWhere: TDAWhere;
begin
  result := fWhere;
end;

function TDAESQLCommand.GetParams: TDAParamCollection;
begin
  result := fParams;
end;

function TDAESQLCommand.ParamByName(const aName: string): TDAParam;
begin
  result := fParams.ParamByName(aName)
end;

procedure TDAESQLCommand.RefreshParams;
var
  lParams: TParams;
  i: integer;
  par: TDAParam;
begin
  //dsparams := GetProviderSupport.PSGetParams;

  lParams := TParams.Create;
  try
    Params_ParseSQL(lParams, fSQL, True, fConnection.GetQuoteChars);

    fParams.Clear;
    for i := 0 to (lParams.Count - 1) do begin
      if fParams.FindParam(lParams[i].Name) <> nil then Continue;
      par := fParams.Add;
      par.Name := lParams[i].Name;
      par.DataType := intVCLTypeToDAType(lParams[i].DataType);
      par.ParamType := TDAParamType(lParams[i].ParamType);
      par.Size := lParams[i].Size;
    end;
  finally
    lParams.Free;
  end;
end;

procedure TDAESQLCommand.SetPrepared(Value: boolean);
begin
  if (fPrepared <> Value) then begin
  fPrepared := Value;
    if fPrepared then PrepareSQLStatement();
  end;
end;

function TDAESQLCommand.GetPrepared: boolean;
begin
  result := fPrepared;
end;

procedure TDAESQLCommand.OnWhereChange(Sender: TObject);
begin
  Changed := true;
  PrepareSQLStatement();
end;

function TDAESQLCommand.Execute: integer;
var
  startTick: cardinal;
begin
  //result := -1;
  // Combines the custom WHERE statement and modifies the inner SQL
  if fChanged then PrepareSQLStatement;

  // Writes the parameter values
  if (fParams.Count > 0) then SetParamValues(fParams) else ClearParams;

  startTick := ROGetTickCount;
  if Assigned(fOnBeforeExecute) then fOnBeforeExecute(Self);

  try
    result := DoExecute;
  except
    on E:Exception do begin
      if Assigned(fOnExecuteError) then fOnExecuteError(Self, DoGetSQL, E);
      raise;
    end;
  end;
  GetParamValues(fParams);

  if Assigned(fOnAfterExecute)
    then fOnAfterExecute(Self, DoGetSQL, ROGetTickCount-startTick);
end;

procedure TDAESQLCommand.PrepareSQLStatement;
var
  temp, sql, wheretext: string;
  orderbypos, wherepos: integer;
  i: integer;
  s: string;
begin
  // Commented out because done above now
  //if not fChanged then Exit; // Avoids resetting it or repreparing

  sql := fSQL;
  try
    fWhere.Changed := False;
    if (fWhere.Clause = '') then Exit;
    temp := UpperCase(sql);

    // TODO: Not exactly the best way to do it. Might conflict with a field name that contains WHERE and might
    // not work if the user writes "ORDER    BY"... We'll fix later with a tokenizer or a real parser of some sort
    orderbypos := Pos('GROUP BY', temp);
    if (orderbypos = 0)
      then orderbypos := Pos('ORDER BY', temp);
    wherepos := Pos('WHERE', temp);

    if (wherepos > 0) then
      wheretext := ' AND (' + fWhere.Clause + ') '
    else
      wheretext := ' WHERE ' + fWhere.Clause + ' ';

    if (orderbypos > 0) then
      Insert(wheretext, sql, orderbypos) // Adds it before the Order By
    else
      Insert(wheretext, sql, Length(sql) + 1); // Adds it at the end since there's no Order By

  finally
    // Sets the SQL of the wrapped dataset
    if Assigned(fConnection.fMacroProcessor) then begin

      i := fConnection.fMacroProcessor.IndexOfName('Where');
      s := GenerateDynamicWhereStatement;
      if i = -1 then
        fConnection.fMacroProcessor.AddVariable('Where').Value:=s
      else
        fConnection.fMacroProcessor.Variable[i].Value:=s;
      SetDynamicWhereParams;


      sql := fConnection.fMacroProcessor.Eval(sql);
    end;

    DoSetSQL(sql);
    DoPrepare(fPrepared);

    Changed := false;
  end;
end;

function TDAESQLCommand.GetSQL: string;
begin
  result := fSQL
end;

procedure TDAESQLCommand.SetSQL(const Value: string);
begin
  if Value <> fSQL then begin
    fSQL := Value;
    fChanged := true;
    if fDataset <> nil then fDataset.FieldDefs.Clear;
    PrepareSQLStatement();
  end;
end;

function TDAESQLCommand.GetDataset: TDataset;
begin
  result := fDataset;
end;

function TDAESQLCommand.GetName: string;
begin
  result := fName;
end;

procedure TDAESQLCommand.DoPrepare(Value: boolean);
begin
  SetPropValue(fDataset, 'Prepared', Value); // Works with ADO and IBX for now
end;

function TDAESQLCommand.GetOnAfterExecute: TDAAfterExecuteCommandEvent;
begin
  result := fOnAfterExecute
end;

function TDAESQLCommand.GetOnBeforeExecute: TDABeforeExecuteCommandEvent;
begin
  result := fOnBeforeExecute
end;

procedure TDAESQLCommand.SetOnAfterExecute(
  const Value: TDAAfterExecuteCommandEvent);
begin
  fOnAfterExecute := Value
end;

procedure TDAESQLCommand.SetOnBeforeExecute(
  const Value: TDABeforeExecuteCommandEvent);
begin
  fOnBeforeExecute := Value
end;

function TDAESQLCommand.GetOnExecuteError: TDAExecuteCommandErrorEvent;
begin
  result := fOnExecuteError;
end;

procedure TDAESQLCommand.SetOnExecuteError(
  const Value: TDAExecuteCommandErrorEvent);
begin
  fOnExecuteError := Value;
end;

function TDAESQLCommand.intVCLTypeToDAType(
  aFieldType: TFieldType): TDADataType;
begin
  Result := VCLTypeToDAType(aFieldType);
end;

function TDAESQLCommand.GetDynamicWhere: TDAWhereBuilder;
begin
  if fDynamicWhere = nil then fDynamicWhere := Connection.GetWhereBuilder;
  Result:=fDynamicWhere;
end;

procedure TDAESQLCommand.SetDynamicWhere(const Value: TDAWhereBuilder);
begin
  if Value <> nil then
    GetDynamicWhere.Xml := Value.Xml
  else if fDynamicWhere <> nil then       
    FDynamicWhere.Clear;
end;

function TDAESQLCommand.GenerateDynamicWhereStatement: string;
begin
  if (fDynamicWhere <> nil) and not fDynamicWhere.IsEmpty then Result := fDynamicWhere.CreateWhereClause;
  if Result = '' then Result:= ' (1=1)';
end;

function TDAESQLCommand.SQLContainsDynamicWhere: boolean;
var
  mac: IDAHasMacroProcessor;
  lmp: TDASQLMacroProcessor;
begin
  FIsPresentDynWhereVariable:=False;
  if Supports(fConnection, IDAHasMacroProcessor, mac) and (mac.GetMacroProcessor <> nil) then begin
    lmp:=TDASQLMacroProcessor(mac.GetMacroProcessor.NewInstance).Create;
    With lmp do try
      OnUnknownIdentifier := UnknownIdentifier;
      Eval(GetSQL);
    finally
      Free;
    end;
  end;
  Result:= FIsPresentDynWhereVariable;
end;

function TDAESQLCommand.UnknownIdentifier(Sender: TObject; const Name,
  OrgName: string; var Value: string): Boolean;
begin
  if SameText(OrgName,'WHERE') then
    FIsPresentDynWhereVariable:=True;
  Value := OrgName;
  Result := True;
end;

procedure TDAESQLCommand.SetDynamicWhereParams;
var
  i: integer;
  k: TDAParam;
begin
  if fDynamicWhere <> nil then
    For i:=0 to fDynamicWhere.Params.Count-1 do begin
      k:=Self.GetParams.FindParam(fDynamicWhere.Params[i].Name);
      if k = nil then k:= Self.GetParams.Add;
      k.AssignField(fDynamicWhere.Params[i]);
    end;
end;

procedure TDAESQLCommand.RemoveDynamicWhereParams;
var
  i: integer;
  k: TDAParam;
begin
  if fDynamicWhere <> nil then
    For i:=0 to fDynamicWhere.Params.Count-1 do begin
      k := Self.GetParams.FindParam(fDynamicWhere.Params[i].Name);
      if k <> nil then Self.GetParams.Delete(k.Index);
    end;
end;

procedure TDAESQLCommand.SetParamValuesStd(Params1: TDAParamCollection;
  Params2: TParams);
var
  i: integer;
  par: TDAParam;
  outpar: TParam;
  ft:     TFieldType;
  lParIsEmpty: Boolean;
begin
  for i := 0 to (Params1.Count - 1) do begin
    par := Params1[i];
    outpar := FindParameter(Params2,par.Name);
    ft := DATypeToVCLType(par.DataType);

    if ft = ftAutoInc then ft := ftInteger;

    case par.ParamType of
      daptInput: outpar.ParamType := ptInput;
      daptOutput: outpar.ParamType := ptOutput;
      daptInputOutput: outpar.ParamType := ptInputOutput;
      daptResult: outpar.ParamType := ptResult;
    end;

    lParIsEmpty := VarIsEmpty(par.Value) or VarIsNull(par.Value);

    if par.DataType = datBlob then begin
      outpar.DataType := ftBlob;
      if not (par.ParamType in [daptOutput, daptResult]) then begin
        if lParIsEmpty then
           outpar.Value := Null
        else
           outpar.Value := VariantBinaryToString(par.Value);
      end;
    end
    else begin
      if (outpar.DataType <> ft) and (ft <> ftUnknown) then outpar.DataType := ft;
      if not (par.ParamType in [daptOutput, daptResult]) then outpar.Value := par.Value;
    end;

    if lParIsEmpty and (par.DataType <> datUnknown) then begin
      if (outpar.DataType <> ft) and (ft <> ftUnknown) then outpar.DataType := ft;
    end;
  end;
end;

procedure TDAESQLCommand.GetParamValuesStd(Params1: TDAParamCollection;
  Params2: TParams);
var
  i: integer;
  par1: TDAParam;
begin
  for i := 0 to Params1.Count-1 do begin
    par1 := Params1[i];
    if Par1.ParamType in [daptOutput, daptInputOutput, daptResult] then
      Par1.Value := FindParameter(Params2,Par1.Name).Value;
  end;
end;

function TDAESQLCommand.FindParameter(const AParams: TParams;
  const AParamName: string): TParam;
begin
  Result := AParams.FindParam(AParamName);
  if Result = nil then
     Result := AParams.FindParam('@'+AParamName);
  if Result = nil then begin
    if AParams.Owner is TDataSet then
      DatabaseErrorFmt(SParameterNotFound, [AParamName], TComponent(AParams.Owner))
    else
      DatabaseErrorFmt(SParameterNotFound, [AParamName])
  end;
end;

procedure TDAESQLCommand.ClearParams;
begin
// nothing
end;

{ TDAEStoredProcedure }

procedure TDAEStoredProcedure.DoPrepare(Value: boolean);
begin
  // Stored procs don't need to be prepared
end;

procedure TDAEStoredProcedure.PrepareSQLStatement;
begin
  // Stored procs don't need to be prepared
end;

procedure TDAEStoredProcedure.RefreshParams;
begin
  raise Exception.Create('RefreshParams must be implemented in descendant.');
end;

procedure TDAEStoredProcedure.RefreshParamsStd(AParams: TParams);
var
  par: TDAParam;
  i: integer;
  lname:string;
begin
  fParams.Clear;
  for i := 0 to (AParams.Count - 1) do begin
    if (AParams[i].DataType = ftInterface) and (AParams[I].ParamType in [ptOutput, ptInputOutput, ptResult]) then Continue;
    par := fParams.Add;
    lName :=AParams[i].Name;
    if Pos('@', lname) = 1 then lName:=copy(lName,2, Length(lName)-1);
    par.Name := lName;
    par.DataType := intVCLTypeToDAType(AParams[i].DataType);
    par.ParamType := TDAParamType(AParams[i].ParamType);
    par.Size := AParams[i].Size;
  end;
end;

{ TDASQLMacroProcessor }

constructor TDASQLMacroProcessor.Create(const aDateFormat, aDateTimeFormat: string;
  aDoubleQuoteStrings: boolean;
  const aStoredProcParamsPrefix: string = '');
begin
  Create;
  fDateFormat := aDateFormat;
  fDateTimeFormat := aDateTimeFormat;
  fDoubleQuoteStrings := aDoubleQuoteStrings;
  fStoredProcParamPrefix := aStoredProcParamsPrefix;
  RegisterMacros;
end;

function TDASQLMacroProcessor.FormatDate(Sender: TObject;
  const Parameters: array of string): string;
var
  dte: TDateTime;
begin
  dte := StrToDate(StringReplace(Parameters[0], '''', '', [rfReplaceAll]));

  if fDoubleQuoteStrings then
    result := '"' + SysUtils.FormatDateTime(fDateFormat, dte) + '"'
  else
    result := '''' + SysUtils.FormatDateTime(fDateFormat, dte) + '''';
end;

function TDASQLMacroProcessor.FormatDateTime(Sender: TObject;
  const Parameters: array of string): string;
var
  dte: TDateTime;
begin
  dte := StrToDateTime(StringReplace(Parameters[0], '''', '', [rfReplaceAll]));

  if fDoubleQuoteStrings then
    result := '"' + SysUtils.FormatDateTime(fDateTimeFormat, dte) + '"'
  else
    result := '''' + SysUtils.FormatDateTime(fDateTimeFormat, dte) + '''';
end;

procedure TDASQLMacroProcessor.RegisterMacros;
begin
  RegisterProc('Date', Date, 0);
  RegisterProc('DateTime', DateTime, 0);
  RegisterProc('AddTime', AddTime, 3);
  RegisterProc('FormatDateTime', FormatDateTime, 1);
  RegisterProc('FormatDate', FormatDate, 1);
  RegisterProc('Length', Length, 1);
  RegisterProc('LowerCase', LowerCase, 1);
  RegisterProc('UpperCase', UpperCase, 1);
  RegisterProc('TrimLeft', TrimLeft, 1);
  RegisterProc('TrimRight', TrimRight, 1);
  RegisterProc('Copy', Copy, 3);
  RegisterProc('NoLockHint', NoLock, 0);
end;

constructor TDASQLMacroProcessor.Create;
begin
  inherited Create;
  OnUnknownIdentifier := MyUnknownIdentifier;
end;

function TDASQLMacroProcessor.Date(Sender: TObject;
  const Parameters: array of string): string;
begin
  result := Self.DateTime(Sender, Parameters);
end;

function TDASQLMacroProcessor.MyUnknownIdentifier(Sender: TObject;
  const Name, OrgName: string; var Value: string): Boolean;
begin
  Value := OrgName;
  Result := True;
end;

{ TDAConnectionWrapper }

procedure TDAConnectionWrapper.DoConnect;
begin
  SetConnected(TRUE);
end;

procedure TDAConnectionWrapper.DoDisconnect;
begin
  SetConnected(FALSE);
end;

{$IFDEF MSWINDOWS}

{ TDAEngineBaseObject }

function TDAEngineBaseObject.InterfaceSupportsErrorInfo(const iid: TGUID): HRESULT;
begin
  if GetInterfaceEntry(iid) <> nil then
    Result := S_OK
  else
    Result := S_FALSE;
end;

procedure TDAEngineBaseObject.OnException(const ServerClass, ExceptionClass, ErrorMessage: WideString;
                                          ExceptAddr: Integer; const ErrorIID, ProgID: WideString;
                                          var Handled: Integer; var Result: HRESULT);
begin

end;

const
  DA_ERROR_ID : TGUID = '{E479A438-2640-41D2-9DC6-1560C1D08B79}';

function StringToWidestring(const aString: string): WideString;
var
  I: Integer;
begin
  SetLength(Result, Length(aString));
  for i := 1 to Length(aString)-1 do
    Result[i] := WideChar(aString[I]);
end;

function DAHandleSafeCallException(aObject:TObject; ExceptObject: TObject; ExceptAddr: Pointer): HResult;
var
  lClassName: string;
  E: TObject;
  CreateError: ICreateErrorInfo;
  ErrorInfo: IErrorInfo;
begin
  Result := E_UNEXPECTED;
  E := ExceptObject;
  if Succeeded(CreateErrorInfo(CreateError)) then begin
    CreateError.SetGUID(DA_ERROR_ID);
    lClassName := aObject.ClassName;
    if MainInstance <> HInstance then
      lClassname := Format('%s in %s',[lClassName,ExtractFileName({$IFDEF FPC}ParamStr(0){$ELSE}GetModuleName(hInstance){$ENDIF})]);
    CreateError.SetSource(PWideChar(StringToWidestring(E.ClassName+': '+lClassName)));
    if E is Exception then begin
      CreateError.SetDescription(PWideChar(WideString(Exception(E).Message)));
      CreateError.SetHelpContext(Exception(E).HelpContext);
      if (E is EOleSysError) and (EOleSysError(E).ErrorCode < 0) then
        Result := EOleSysError(E).ErrorCode;
    end;
    if CreateError.QueryInterface(IErrorInfo, ErrorInfo) = S_OK then
      SetErrorInfo(0, ErrorInfo);
  end;
end;

function TDAEngineBaseObject.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult;
begin
  Result := DAHandleSafeCallException(self, ExceptObject, ExceptAddr);
end;

procedure DASafeCallError(ErrorCode: Integer; ErrorAddr: Pointer);
var
  lExceptionClass: ExceptClass;
  p: Integer;
  lSource: WideString;
  ErrorInfo: IErrorInfo;
  lDescription: WideString;
  lGuid: TGUID;
begin
  if GetErrorInfo(0, ErrorInfo) = S_OK then begin
    ErrorInfo.GetDescription(lDescription);
    ErrorInfo.GetGUID(lGuid);
    if IsEqualGUID(lGuid,DA_ERROR_ID) then begin
      ErrorInfo.GetSource(lSource);
      p := Pos(':', lSource);
      if p > 0 then begin
        lExceptionClass := GetExceptionClass(copy(lSource,1,p-1));
        if Assigned(lExceptionClass) then
          raise lExceptionClass.Create(lDescription);
      end;
    end;
    raise Exception.Create(lDescription) at ErrorAddr;
  end
  else begin
    raise Exception.Create('A "safecall" error occured, but the source object did not provide the proper error information. Sorry we cannot be more helpful at this time.') at ErrorAddr;
  end;
end;

initialization
  SafeCallErrorProc := @DASafeCallError;
  RegisterExceptionClass(EAbort);
finalization
  UnregisterExceptionClass(EAbort);
  SafeCallErrorProc := nil;
{$ENDIF}
end.