2875 lines
92 KiB
ObjectPascal
2875 lines
92 KiB
ObjectPascal
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;
|
|
|
|
IDANativeDatabaseAccess = interface
|
|
['{0AC0565B-9500-4A90-B55D-25CB04568F9B}']
|
|
procedure ClearFieldDefs;
|
|
function GetRecordCount: Integer;
|
|
function GetBOF:Boolean;
|
|
function GetEOF:Boolean;
|
|
function GetActive:Boolean;
|
|
procedure SetActive(const aValue: Boolean);
|
|
procedure Next;
|
|
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
|
function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;
|
|
function GetFieldName(Index: Integer): string;
|
|
procedure DisableControls;
|
|
procedure EnableControls;
|
|
function ControlsDisabled: Boolean;
|
|
function GetIsEmpty: boolean;
|
|
procedure FreeBookmark(Bookmark: TBookmark);
|
|
function GetBookMark: pointer;
|
|
procedure GotoBookmark(Bookmark: TBookmark);
|
|
function GetState: TDatasetState;
|
|
procedure Prepare(const AValue: Boolean);
|
|
function GetFields(Index: integer): IDANativeField;
|
|
function FieldCount: Integer;
|
|
function FindField(const FieldName: string): IDANativeField;
|
|
function IsTDatasetCompatible: Boolean;
|
|
property Active: Boolean read GetActive write SetActive;
|
|
function GetNativeFieldData(Index: Integer; var Data: pointer; var DataSize: cardinal):Boolean;
|
|
function GetNativeFieldValue(Index: Integer): Variant;
|
|
function CanFreeNativeFieldData: Boolean;
|
|
end;
|
|
|
|
TDANativeField_Dataset = class(TInterfacedObject, IDANativeField)
|
|
private
|
|
fField: TField;
|
|
protected
|
|
function GetNativeObject: TObject;
|
|
function isTFieldCompatible: Boolean;
|
|
function GetFieldName: string;
|
|
function GetDataType: TFieldType;
|
|
function GetSize: integer;
|
|
function GetDecimalPrecision: Integer;
|
|
procedure SetDecimalPrecision(Value: integer);
|
|
function GetDecimalScale: Integer;
|
|
procedure SetDecimalScale(Value: integer);
|
|
procedure SetDataType(Value: TFieldType);
|
|
public
|
|
constructor Create(AField: TField);
|
|
end;
|
|
|
|
TDANativeDatabaseAccess_Dataset = class(TInterfacedObject,IDANativeDatabaseAccess)
|
|
private
|
|
FDataset: TDataSet;
|
|
fList: TInterfaceList;
|
|
protected
|
|
procedure ClearFieldDefs;
|
|
function GetRecordCount: Integer;
|
|
function GetBOF:Boolean;
|
|
function GetEOF:Boolean;
|
|
function GetActive:Boolean;
|
|
procedure SetActive(const aValue: Boolean);
|
|
procedure Next;
|
|
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
|
function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;
|
|
function GetFieldName(Index: Integer): string;
|
|
procedure DisableControls;
|
|
procedure EnableControls;
|
|
function GetIsEmpty: boolean;
|
|
procedure FreeBookmark(Bookmark: TBookmark);
|
|
function GetBookMark: pointer;
|
|
procedure GotoBookmark(Bookmark: TBookmark);
|
|
function GetState: TDatasetState;
|
|
function ControlsDisabled: Boolean;
|
|
procedure Prepare(const AValue: Boolean);
|
|
function GetFields(Index: integer): IDANativeField;
|
|
function FieldCount: Integer;
|
|
function FindField(const FieldName: string): IDANativeField;
|
|
function IsTDatasetCompatible: Boolean;
|
|
function GetNativeFieldData(Index: Integer; var Data: pointer; var DataSize: cardinal):Boolean;
|
|
function CanFreeNativeFieldData: Boolean;
|
|
function GetNativeFieldValue(Index: Integer): Variant;
|
|
public
|
|
Constructor Create(ADataset: TDataSet);
|
|
destructor Destroy;override;
|
|
end;
|
|
|
|
{ 20080408:
|
|
Dataset-compatible drivers - default mode, i.e. no changes is required.
|
|
|
|
|
|
non-Dataset-compatible drivers:
|
|
|
|
you should create objects that supports
|
|
IDANativeField, IDANativeDatabaseAccess
|
|
|
|
xxxQuery:
|
|
---------
|
|
you should override in addition:
|
|
function CreateNativeDatabaseAccess: IDANativeDatabaseAccess; // point to IDANativeDatabaseAccess
|
|
function CreateNativeObject(aConnection: TDAEConnection): TObject; // Result - point to your native object
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; // you can raise error or return nil
|
|
you can use
|
|
property NativeDatabaseAccess: IDANativeDatabaseAccess read fNativeDatabaseAccess; // your object which you return with CreateNativeDatabaseAccess
|
|
property NativeObject: TObject read GetNativeObject; // your object created with CreateNativeObject
|
|
|
|
|
|
XXXStoredProcedure
|
|
------------------
|
|
you should override in addition:
|
|
function CreateNativeObject(aConnection: TDAEConnection): TObject; // Result - point to your native object
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; // you can raise error or return nil
|
|
you can use
|
|
property NativeObject: TObject read GetNativeObject; // your object created with CreateNativeObject
|
|
}
|
|
|
|
{ TDAESQLCommand }
|
|
{$WARN SYMBOL_DEPRECATED OFF}
|
|
TDAESQLCommand = class(TDAEngineBaseObject, IDASQLCommand, IDAMustSetParams, IDASQLCommandNativeObject)
|
|
private
|
|
fConnection: TDAEConnection;
|
|
fDataset: TDataset;
|
|
FNativeObject: TObject;
|
|
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;
|
|
|
|
{ non-dataset mode}
|
|
protected
|
|
fNativeDatabaseAccess: IDANativeDatabaseAccess;
|
|
function CreateNativeDatabaseAccess: IDANativeDatabaseAccess; virtual;
|
|
{ non-dataset mode end}
|
|
|
|
// 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 CreateNativeObject(aConnection: TDAEConnection): TObject; virtual;
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; virtual; abstract;
|
|
|
|
procedure DoPrepare(Value: boolean); virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF} abstract;
|
|
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;
|
|
|
|
//IDASQLCommandNativeObject
|
|
function GetNativeObject: TObject; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetNativeFields(Index: integer): IDANativeField;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function NativeFieldCount: Integer;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function NativeFindField(const FieldName: string): IDANativeField;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function IsTDatasetCompatible: Boolean; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetNativeFieldData(Index: Integer; var Data: pointer; var DataSize: cardinal):Boolean; virtual; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function CanFreeNativeFieldData: Boolean;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
// 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; virtual;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure SetSQL(const Value: string); virtual;{$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 NativeObject: TObject read GetNativeObject;
|
|
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;
|
|
FNativeIndex: array of integer;
|
|
protected
|
|
property NativeDatabaseAccess: IDANativeDatabaseAccess read fNativeDatabaseAccess;
|
|
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;
|
|
procedure DoPrepare(Value: boolean); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
//IDASQLCommandNativeObject
|
|
function GetNativeFieldData(Index: Integer; var Data: pointer; var DataSize: cardinal):Boolean; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
// 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)
|
|
protected
|
|
function CreateNativeDatabaseAccess: IDANativeDatabaseAccess; override;
|
|
procedure RefreshParamsStd(AParams: TParams);
|
|
// Internal
|
|
procedure DoPrepare(Value: boolean); override;
|
|
procedure RefreshParams; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure SetSQL(const Value: string); 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 GetAvailableDriverOptionsEx(AuxDriver: string): 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;
|
|
function TestIdentifier(const iIdentifier: string; const ReservedWords: array of string): boolean;
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF MSWINDOWS}Windows,{$ENDIF} Variants,{$IFDEF FPC}dbconst,{$ELSE}DBConsts,{$ENDIF}
|
|
{$IFNDEF Drivers_CompatibilityMode}{$IFNDEF FPC}SqlTimSt,{$ENDIF}{$ENDIF}FMTBcd,
|
|
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.GetAvailableDriverOptionsEx(AuxDriver: string): TDAAvailableDriverOptions;
|
|
begin
|
|
result := GetAvailableDriverOptions;
|
|
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 CharInSet(iIdentifier[i], ['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 CharInSet(iIdentifier[i+1], ['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(fFields);
|
|
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 := FNativeDatabaseAccess.Active;
|
|
end;
|
|
|
|
function TDAEDataset.DoGetBOF: boolean;
|
|
begin
|
|
result := FNativeDatabaseAccess.GetBOF;
|
|
end;
|
|
|
|
function TDAEDataset.DoGetEOF: boolean;
|
|
begin
|
|
result := FNativeDatabaseAccess.GetEOF;
|
|
end;
|
|
|
|
function TDAEDataset.DoGetRecordCount: integer;
|
|
begin
|
|
result := FNativeDatabaseAccess.GetRecordCount;
|
|
end;
|
|
|
|
function TDAEDataset.DoLocate(const KeyFields: string;
|
|
const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
|
begin
|
|
result := FNativeDatabaseAccess.Locate(KeyFields, KeyValues, Options);
|
|
end;
|
|
|
|
procedure TDAEDataset.DoNext;
|
|
begin
|
|
FNativeDatabaseAccess.Next;
|
|
end;
|
|
|
|
procedure TDAEDataset.DoPrepare(Value: boolean);
|
|
begin
|
|
FNativeDatabaseAccess.Prepare(Value);
|
|
end;
|
|
|
|
procedure TDAEDataset.DoSetActive(Value: boolean);
|
|
var
|
|
i: integer;
|
|
fld: IDANativeField;
|
|
startTick: Cardinal;
|
|
s: string;
|
|
dafld: TDAField;
|
|
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
|
|
FNativeDatabaseAccess.Active := True;
|
|
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 (FNativeDatabaseAccess.FieldCount - 1) do begin
|
|
fld := FNativeDatabaseAccess.GetFields(i);
|
|
with fFields.Add(fld.FieldName, intVCLTypeToDAType(fld.DataType), fld.Size) do begin
|
|
if DataType = datDecimal then begin
|
|
case fld.DataType of
|
|
ftFMTBcd: begin
|
|
DecimalPrecision:= fld.DecimalPrecision;
|
|
DecimalScale:= fld.DecimalScale;
|
|
end;
|
|
ftBCD: begin
|
|
DecimalPrecision:= fld.DecimalPrecision;
|
|
DecimalScale:= fld.DecimalScale;
|
|
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(Self);
|
|
SetLength(FNativeIndex,fFields.Count);
|
|
for i := 0 to fFields.Count - 1 do
|
|
FNativeIndex[i] := -1;
|
|
for i := 0 to fNativeDatabaseAccess.FieldCount - 1 do begin
|
|
dafld := fFields.FindField(fNativeDatabaseAccess.GetFieldName(i));
|
|
if dafld <> nil then FNativeIndex[dafld.Index] := i;
|
|
end;
|
|
end
|
|
else begin
|
|
if fAutoFields then
|
|
fFields.Clear
|
|
else
|
|
fFields.Unbind;
|
|
|
|
FNativeDatabaseAccess.Active := False;
|
|
SetLength(FNativeIndex,0);
|
|
end;
|
|
end;
|
|
|
|
{$IFNDEF FPC}
|
|
type
|
|
PLargeint = ^Largeint;
|
|
Largeint = Int64;
|
|
{$ENDIF}
|
|
|
|
function TDAEDataset.GetFieldValues(Index: integer): Variant;
|
|
{$IFNDEF Drivers_CompatibilityMode}
|
|
var
|
|
data: pointer;
|
|
Datasize: Cardinal;
|
|
s: Ansistring;
|
|
{$ENDIF}
|
|
begin
|
|
if GetFields[Index].ServerCalculated then begin
|
|
Result := Null;
|
|
end
|
|
else begin
|
|
Index := FNativeIndex[Index];
|
|
{$IFDEF Drivers_CompatibilityMode}
|
|
Result := fNativeDatabaseAccess.GetNativeFieldValue(Index);
|
|
{$ELSE}
|
|
{$IFDEF FPC}
|
|
Data := nil;
|
|
Datasize := 0;
|
|
{$ENDIF}
|
|
if not fNativeDatabaseAccess.GetNativeFieldData(Index, Data, Datasize) then begin
|
|
Result:= Null;
|
|
end
|
|
else begin
|
|
case fNativeDatabaseAccess.GetFields(Index).DataType of
|
|
ftString, {$IFDEF DELPHI10UP}ftOraInterval, {$ENDIF}
|
|
ftFixedChar,
|
|
ftGuid: Result := AnsiString(PAnsiChar(Data));
|
|
ftSmallint: Result := PSmallint(Data)^;
|
|
ftInteger: Result := PInteger(Data)^;
|
|
ftWord: Result := PWord(Data)^;
|
|
ftBoolean: Result := PWordBool(data)^;
|
|
ftFloat,
|
|
ftCurrency: Result := PDouble(data)^;
|
|
ftBcd: Result := PCurrency(data)^;
|
|
ftDate: Result := PInteger(Data)^;
|
|
ftTime: Result := PInteger(Data)^;
|
|
ftDateTime: Result := PDateTime(Data)^;
|
|
ftBytes,
|
|
ftVarBytes: Result := POleVariant(Data)^;
|
|
ftAutoInc: Result := PInteger(Data)^;
|
|
ftBlob..ftTypedBinary, ftOraBlob, ftOraClob{$IFDEF DELPHI10UP}, ftWideMemo{$ENDIF}: begin
|
|
SetString(s, PChar(Data), DataSize);
|
|
Result := s;
|
|
end;
|
|
ftCursor: Result := Null;
|
|
{$IFDEF DELPHI10UP}
|
|
ftFixedWideChar,
|
|
{$ENDIF}
|
|
ftWideString: Result := WideString(PWideChar(Data));
|
|
ftLargeint: Result := PLargeint(Data)^;
|
|
// objects types
|
|
ftADT, ftArray, ftReference, ftDataSet:
|
|
Result := varNull;
|
|
ftVariant: Result := PVariant(Data)^;
|
|
ftInterface: Result := IUnknown(Data^);
|
|
ftIDispatch: Result := IDispatch(Data^);
|
|
{$IFNDEF FPC}
|
|
{$IFDEF DELPHI10UP}ftOraTimeStamp,{$ENDIF}
|
|
ftTimeStamp: Result := VarSQLTimeStampCreate(PSQLTimeStamp(data)^);
|
|
{$ENDIF FPC}
|
|
ftFMTBcd: Result := BCDToVariant(PBcd(Data)^);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function TDAEDataset.GetNames(Index: integer): string;
|
|
begin
|
|
result := FNativeDatabaseAccess.GetFieldName(Index);
|
|
end;
|
|
|
|
procedure TDAEDataset.DisableControls;
|
|
begin
|
|
FNativeDatabaseAccess.DisableControls;
|
|
end;
|
|
|
|
procedure TDAEDataset.EnableControls;
|
|
begin
|
|
FNativeDatabaseAccess.EnableControls;
|
|
end;
|
|
|
|
function TDAEDataset.FieldByName(const aName: string): TDAField;
|
|
begin
|
|
result := fFields.FieldByName(aName) as TDAField;
|
|
end;
|
|
|
|
procedure TDAEDataset.FreeBookmark(Bookmark: TBookmark);
|
|
begin
|
|
FNativeDatabaseAccess.FreeBookmark(Bookmark);
|
|
end;
|
|
|
|
function TDAEDataset.GetBookMark: pointer;
|
|
begin
|
|
result := FNativeDatabaseAccess.GetBookmark;
|
|
end;
|
|
|
|
procedure TDAEDataset.GotoBookmark(Bookmark: TBookmark);
|
|
begin
|
|
FNativeDatabaseAccess.GotoBookmark(Bookmark);
|
|
end;
|
|
|
|
procedure TDAEDataset.Refresh;
|
|
begin
|
|
|
|
end;
|
|
|
|
function TDAEDataset.GetIsEmpty: boolean;
|
|
begin
|
|
result := FNativeDatabaseAccess.GetIsEmpty;
|
|
end;
|
|
|
|
function TDAEDataset.GetState: TDatasetState;
|
|
begin
|
|
result := FNativeDatabaseAccess.GetState;
|
|
end;
|
|
|
|
function TDAEDataset.Lookup(const KeyFields: string;
|
|
const KeyValues: Variant; const ResultFields: string): Variant;
|
|
begin
|
|
result := FNativeDatabaseAccess.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;
|
|
{$IFDEF ftFMTBCD_Support}
|
|
var
|
|
i: integer;
|
|
lNeedToFix: Boolean;
|
|
fld: TFieldDef;
|
|
dafld: TDAField;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF ftFMTBCD_Support}
|
|
// this only for DBX driver => DatasetCompatible
|
|
if IsTDatasetCompatible then begin
|
|
lNeedToFix:= False;
|
|
for i:=0 to fDataset.FieldCount-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;
|
|
FNativeDatabaseAccess.Active := False;
|
|
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;
|
|
FNativeDatabaseAccess.Active := True;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TDAEDataset.FixKnownIssues;
|
|
begin
|
|
if IsNeedToFixFMTBCDIssue then FixFMTBCDIssue;
|
|
end;
|
|
|
|
function TDAEDataset.ControlsDisabled: Boolean;
|
|
begin
|
|
Result := FNativeDatabaseAccess.ControlsDisabled;
|
|
end;
|
|
|
|
function TDAEDataset.GetNativeFieldData(Index: Integer; var Data: pointer;
|
|
var DataSize: cardinal): Boolean;
|
|
begin
|
|
if GetFields[Index].ServerCalculated then begin
|
|
Result := False;
|
|
Data := nil;
|
|
DataSize := 0;
|
|
end
|
|
else begin
|
|
Result := inherited GetNativeFieldData(FNativeIndex[Index], Data, DataSize);
|
|
end;
|
|
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);
|
|
FNativeObject := CreateNativeObject(fConnection);
|
|
FNativeDatabaseAccess := CreateNativeDatabaseAccess;
|
|
end;
|
|
|
|
destructor TDAESQLCommand.Destroy;
|
|
begin
|
|
FNativeDatabaseAccess:=nil;
|
|
if FNativeObject <> fDataset then FreeAndNil(FNativeObject) else FNativeObject := nil;
|
|
FreeAndNil(fDataset);
|
|
FreeAndNil(fParams);
|
|
FreeAndNil(fWhere);
|
|
FreeAndNil(fDynamicWhere);
|
|
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;
|
|
FNativeDatabaseAccess.ClearFieldDefs;
|
|
PrepareSQLStatement();
|
|
end;
|
|
end;
|
|
|
|
function TDAESQLCommand.GetDataset: TDataset;
|
|
begin
|
|
result := fDataset;
|
|
end;
|
|
|
|
function TDAESQLCommand.GetName: string;
|
|
begin
|
|
result := fName;
|
|
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;
|
|
|
|
|
|
function TDAESQLCommand.GetNativeObject: TObject;
|
|
begin
|
|
Result:= FNativeObject;
|
|
end;
|
|
|
|
function TDAESQLCommand.CreateNativeObject(
|
|
aConnection: TDAEConnection): TObject;
|
|
begin
|
|
Result:= fDataset;
|
|
end;
|
|
|
|
function TDAESQLCommand.CreateNativeDatabaseAccess: IDANativeDatabaseAccess;
|
|
begin
|
|
Result := TDANativeDatabaseAccess_Dataset.Create(GetDataset);
|
|
end;
|
|
|
|
function TDAESQLCommand.NativeFieldCount: Integer;
|
|
begin
|
|
Result := FNativeDatabaseAccess.FieldCount;
|
|
end;
|
|
|
|
function TDAESQLCommand.NativeFindField(const FieldName: string): IDANativeField;
|
|
begin
|
|
Result := FNativeDatabaseAccess.FindField(FieldName);
|
|
end;
|
|
|
|
function TDAESQLCommand.GetNativeFields(Index: integer): IDANativeField;
|
|
begin
|
|
Result := FNativeDatabaseAccess.GetFields(Index);
|
|
end;
|
|
|
|
function TDAESQLCommand.IsTDatasetCompatible: Boolean;
|
|
begin
|
|
Result :=FNativeDatabaseAccess.IsTDatasetCompatible;
|
|
end;
|
|
|
|
function TDAESQLCommand.GetNativeFieldData(Index: Integer; var Data: pointer; var DataSize: cardinal):Boolean;
|
|
begin
|
|
Result := FNativeDatabaseAccess.GetNativeFieldData(Index, Data, DataSize);
|
|
end;
|
|
|
|
function TDAESQLCommand.CanFreeNativeFieldData: Boolean;
|
|
begin
|
|
Result := FNativeDatabaseAccess.CanFreeNativeFieldData;
|
|
end;
|
|
|
|
{ TDAEStoredProcedure }
|
|
|
|
function TDAEStoredProcedure.CreateNativeDatabaseAccess: IDANativeDatabaseAccess;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
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;
|
|
|
|
procedure TDAEStoredProcedure.SetSQL(const Value: string);
|
|
begin
|
|
// nothing: it's removing usage of IDANativeDatabaseAccess
|
|
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
|
|
{$IFDEF FPC}
|
|
if ExceptObject <> nil then Result := E_UNEXPECTED else // remove warnings
|
|
{$ENDIF}
|
|
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;
|
|
{$ENDIF MSWINDOWS}
|
|
|
|
{ TDANativeDatabaseAccess_Dataset }
|
|
|
|
function TDANativeDatabaseAccess_Dataset.CanFreeNativeFieldData: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TDANativeDatabaseAccess_Dataset.ClearFieldDefs;
|
|
begin
|
|
FDataset.FieldDefs.Clear;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.ControlsDisabled: Boolean;
|
|
begin
|
|
Result := FDataset.ControlsDisabled;
|
|
end;
|
|
|
|
constructor TDANativeDatabaseAccess_Dataset.Create(ADataset: TDataSet);
|
|
begin
|
|
inherited Create;
|
|
if ADataset = nil then DatabaseError('A dataset must be specified.');
|
|
FDataset := ADataset;
|
|
FList := TInterfaceList.Create;
|
|
end;
|
|
|
|
destructor TDANativeDatabaseAccess_Dataset.Destroy;
|
|
begin
|
|
FList.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDANativeDatabaseAccess_Dataset.DisableControls;
|
|
begin
|
|
FDataset.DisableControls;
|
|
end;
|
|
|
|
procedure TDANativeDatabaseAccess_Dataset.EnableControls;
|
|
begin
|
|
FDataset.EnableControls;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.FieldCount: Integer;
|
|
begin
|
|
Result := FDataset.FieldCount;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.FindField(
|
|
const FieldName: string): IDANativeField;
|
|
begin
|
|
Result := FList[FDataset.FindField(FieldName).Index] as IDANativeField;
|
|
end;
|
|
|
|
procedure TDANativeDatabaseAccess_Dataset.FreeBookmark(
|
|
Bookmark: TBookmark);
|
|
begin
|
|
FDataset.FreeBookmark(Bookmark);
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.GetActive: Boolean;
|
|
begin
|
|
Result := FDataset.Active;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.GetBOF: Boolean;
|
|
begin
|
|
Result := FDataset.Bof;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.GetBookMark: pointer;
|
|
begin
|
|
Result := FDataset.GetBookmark;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.GetEOF: Boolean;
|
|
begin
|
|
Result := FDataset.Eof;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.GetFieldName(
|
|
Index: Integer): string;
|
|
begin
|
|
result := fDataset.Fields[Index].FieldName;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.GetFields(
|
|
Index: integer): IDANativeField;
|
|
begin
|
|
Result := FList[Index] as IDANativeField;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.GetIsEmpty: boolean;
|
|
begin
|
|
result := fDataset.IsEmpty;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.GetNativeFieldData(Index: Integer;
|
|
var Data:Pointer; var DataSize: cardinal): Boolean;
|
|
var
|
|
str: TStream;
|
|
fld: TField;
|
|
{$IFNDEF DELPHI10UP}
|
|
temp: pointer;
|
|
{$ENDIF DELPHI10UP}
|
|
begin
|
|
Data := nil;
|
|
DataSize := 0;
|
|
fld:= FDataset.Fields[Index];
|
|
try
|
|
if fld.IsBlob then begin
|
|
Str:= FDataset.CreateBlobStream(fld, bmRead);
|
|
try
|
|
DataSize := str.Size;
|
|
GetMem(Data, DataSize);
|
|
str.Read(Data^,Datasize);
|
|
finally
|
|
Str.Free;
|
|
end;
|
|
Result := True;
|
|
end
|
|
else if fld.DataType in [ftADT, ftArray, ftReference, ftDataSet] then begin
|
|
// not supported yet
|
|
Result := False;
|
|
end
|
|
else begin
|
|
DataSize := fld.DataSize;
|
|
GetMem(Data, DataSize);
|
|
{$IFNDEF DELPHI10UP}
|
|
if fld.DataType = ftWideString then FillChar(Data^,DataSize,0);
|
|
{$ENDIF DELPHI10UP}
|
|
Result := FDataset.GetFieldData(fld, Data, False);
|
|
case fld.DataType of
|
|
ftString,ftFixedChar: DataSize := StrLen(PAnsiChar(Data));
|
|
{$IFNDEF DELPHI10UP}
|
|
ftWideString: begin
|
|
DataSize := Length(PWideString(Data)^);
|
|
GetMem(temp, (DataSize+1)*SizeOf(WideChar));
|
|
Move(PWideChar(Data^)^, PWideChar(temp)^, datasize * SizeOf(WideChar));
|
|
PWideChar(temp)[datasize] := #0;
|
|
FreeMem(Data);
|
|
data := temp;
|
|
datasize := DataSize*SizeOf(WideChar);
|
|
end;
|
|
{$ENDIF DELPHI10UP}
|
|
end;
|
|
end;
|
|
except
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.GetNativeFieldValue(
|
|
Index: Integer): Variant;
|
|
begin
|
|
Result := FDataset.Fields[Index].AsVariant;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.GetRecordCount: Integer;
|
|
begin
|
|
Result := FDataset.RecordCount;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.GetState: TDatasetState;
|
|
begin
|
|
Result := FDataset.State;
|
|
end;
|
|
|
|
procedure TDANativeDatabaseAccess_Dataset.GotoBookmark(
|
|
Bookmark: TBookmark);
|
|
begin
|
|
FDataset.GotoBookmark(Bookmark);
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.IsTDatasetCompatible: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.Locate(const KeyFields: string;
|
|
const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
|
begin
|
|
Result := FDataset.Locate(KeyFields, KeyValues, Options);
|
|
end;
|
|
|
|
function TDANativeDatabaseAccess_Dataset.Lookup(const KeyFields: string;
|
|
const KeyValues: Variant; const ResultFields: string): Variant;
|
|
begin
|
|
Result := FDataset.Lookup(KeyFields, KeyValues, ResultFields);
|
|
end;
|
|
|
|
procedure TDANativeDatabaseAccess_Dataset.Next;
|
|
begin
|
|
FDataset.Next;
|
|
end;
|
|
|
|
procedure TDANativeDatabaseAccess_Dataset.Prepare(const AValue: Boolean);
|
|
begin
|
|
SetPropValue(fDataset, 'Prepared', aValue); // Works with ADO and IBX for now
|
|
end;
|
|
|
|
procedure TDANativeDatabaseAccess_Dataset.SetActive(const aValue: Boolean);
|
|
var
|
|
i: integer;
|
|
begin
|
|
fList.Clear;
|
|
FDataset.Active := aValue;
|
|
if FDataset.Active then
|
|
for i:=0 to FDataset.FieldCount-1 do
|
|
fList.Add(TDANativeField_Dataset.Create(FDataset.Fields[i]));
|
|
end;
|
|
|
|
{ TDANativeField_Dataset }
|
|
|
|
constructor TDANativeField_Dataset.Create(AField: TField);
|
|
begin
|
|
Inherited Create();
|
|
FField:= AField;
|
|
end;
|
|
|
|
function TDANativeField_Dataset.GetDataType: TFieldType;
|
|
begin
|
|
Result := fField.DataType;
|
|
end;
|
|
|
|
function TDANativeField_Dataset.GetDecimalPrecision: Integer;
|
|
begin
|
|
{$IFDEF ftFMTBCD_Support}
|
|
if (fField is TFMTBCDField) then
|
|
Result := TFMTBCDField(fField).Precision
|
|
else
|
|
{$ENDIF}
|
|
if (fField is TBCDField) then
|
|
Result := TBCDField(fField).Precision
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TDANativeField_Dataset.GetDecimalScale: Integer;
|
|
begin
|
|
{$IFDEF ftFMTBCD_Support}
|
|
if (fField is TFMTBCDField) then
|
|
Result := TFMTBCDField(fField).Size
|
|
else
|
|
{$ENDIF FPC}
|
|
if (fField is TBCDField) then
|
|
Result := TBCDField(fField).Size
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TDANativeField_Dataset.GetFieldName: string;
|
|
begin
|
|
Result := fField.FieldName;
|
|
end;
|
|
|
|
function TDANativeField_Dataset.GetNativeObject: TObject;
|
|
begin
|
|
Result := FField;
|
|
end;
|
|
|
|
function TDANativeField_Dataset.GetSize: integer;
|
|
begin
|
|
Result := fField.Size;
|
|
end;
|
|
|
|
function TDANativeField_Dataset.isTFieldCompatible: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TDANativeField_Dataset.SetDataType(Value: TFieldType);
|
|
begin
|
|
if fField is TBlobField then
|
|
TBlobField(fField).BlobType := Value;
|
|
end;
|
|
|
|
procedure TDANativeField_Dataset.SetDecimalPrecision(Value: integer);
|
|
begin
|
|
{$IFDEF ftFMTBCD_Support}
|
|
if (fField is TFMTBCDField) then begin
|
|
if TFMTBCDField(fField).Precision <> Value then
|
|
TFMTBCDField(fField).Precision := Value
|
|
end
|
|
else
|
|
{$ENDIF FPC}
|
|
if (fField is TBCDField) then begin
|
|
if TBCDField(fField).Precision <> Value then
|
|
TBCDField(fField).Precision := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDANativeField_Dataset.SetDecimalScale(Value: integer);
|
|
begin
|
|
{$IFDEF ftFMTBCD_Support}
|
|
if (fField is TFMTBCDField) then begin
|
|
if TFMTBCDField(fField).Size <> Value then
|
|
TFMTBCDField(fField).Size := Value
|
|
end
|
|
else
|
|
{$ENDIF FPC}
|
|
if (fField is TBCDField) then begin
|
|
if TBCDField(fField).Size <> Value then
|
|
TBCDField(fField).Size := Value;
|
|
end;
|
|
end;
|
|
|
|
function TestIdentifier(const iIdentifier: string; const ReservedWords: array of string): boolean;
|
|
var
|
|
L,H,I, r: Integer;
|
|
lIdent : string;
|
|
begin
|
|
Result := False;
|
|
lIdent := UpperCase(iIdentifier);
|
|
l := 0;
|
|
h := Length(ReservedWords) -1;
|
|
while l <= h do begin
|
|
i := (L + H) shr 1;
|
|
r := CompareStr(lIdent, ReservedWords[i]);
|
|
if r < 0 then h := i - 1 else
|
|
if r > 0 then l := i + 1 else begin
|
|
Result := true;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
initialization
|
|
SafeCallErrorProc := @DASafeCallError;
|
|
RegisterExceptionClass(EAbort);
|
|
finalization
|
|
UnregisterExceptionClass(EAbort);
|
|
SafeCallErrorProc := nil;
|
|
{$ENDIF}
|
|
end.
|