2188 lines
65 KiB
ObjectPascal
2188 lines
65 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;
|
|
|
|
{ TDAESQLCommand }
|
|
{$WARN SYMBOL_DEPRECATED OFF}
|
|
TDAESQLCommand = class(TDAEngineBaseObject, IDASQLCommand)
|
|
private
|
|
fConnection: TDAEConnection;
|
|
fDataset: TDataset;
|
|
fParams: TDAParamCollection;
|
|
fWhere: TDAWhere;
|
|
fDynamicWhere: TDASQLWhereBuilder;
|
|
fChanged: boolean;
|
|
fSQL: string;
|
|
fName: string;
|
|
fPrepared: boolean;
|
|
//fOrderBy : string;
|
|
fOnAfterExecute: TDAAfterExecuteCommandEvent;
|
|
fOnBeforeExecute: TDABeforeExecuteCommandEvent;
|
|
fOnExecuteError: TDAExecuteCommandErrorEvent;
|
|
FIsPresentDynWhereVariable: Boolean;
|
|
function UnknownIdentifier(Sender: TObject; const Name, OrgName: string; var Value: string): Boolean;
|
|
protected
|
|
// Internal
|
|
function GetProviderSupport: IProviderSupport;
|
|
procedure OnWhereChange(Sender: TObject);
|
|
procedure PrepareSQLStatement; virtual;
|
|
function GenerateDynamicWhereStatement: string;
|
|
function SQLContainsDynamicWhere: boolean;safecall;
|
|
|
|
// To be overridden
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; virtual; abstract;
|
|
|
|
procedure DoPrepare(Value: boolean); virtual; safecall;
|
|
function DoExecute: integer; virtual; safecall;
|
|
procedure DoSetSQL(const Value: string); virtual; safecall; abstract;
|
|
function DoGetSQL: string; virtual; safecall;abstract;
|
|
|
|
// IDASQLCommand
|
|
function GetDataset: TDataset; safecall;
|
|
function GetPrepared: boolean; safecall;
|
|
procedure SetPrepared(Value: boolean); safecall;
|
|
function GetParams: TDAParamCollection; safecall;
|
|
procedure RefreshParams; virtual; safecall;
|
|
function Execute: integer; virtual; safecall;
|
|
function GetWhere: TDAWhere; safecall; deprecated;
|
|
function GetDynamicWhere: TDAWhereBuilder; safecall;
|
|
procedure SetDynamicWhere(const Value: TDAWhereBuilder);safecall;
|
|
function GetSQL: string; safecall;
|
|
procedure SetSQL(const Value: string); safecall;
|
|
function GetName: string; safecall;
|
|
|
|
function ParamByName(const aName: string): TDAParam; safecall;
|
|
|
|
property Dataset: TDataset read GetDataset;
|
|
property Changed: boolean read fChanged write fChanged;
|
|
property Connection: TDAEConnection read fConnection;
|
|
|
|
function GetOnAfterExecute: TDAAfterExecuteCommandEvent; safecall;
|
|
function GetOnBeforeExecute: TDABeforeExecuteCommandEvent; safecall;
|
|
procedure SetOnAfterExecute(const Value: TDAAfterExecuteCommandEvent); safecall;
|
|
procedure SetOnBeforeExecute(const Value: TDABeforeExecuteCommandEvent); safecall;
|
|
function GetOnExecuteError: TDAExecuteCommandErrorEvent; safecall;
|
|
procedure SetOnExecuteError(const Value: TDAExecuteCommandErrorEvent); safecall;
|
|
function intVCLTypeToDAType(aFieldType: TFieldType): TDADataType;virtual;
|
|
public
|
|
constructor Create(aConnection: TDAEConnection; const aName: string = ''); virtual;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TDAEDataset }
|
|
TDAEDataset = class(TDAESQLCommand, IDASQLCommand, IDADataset)
|
|
private
|
|
fAutoFields: boolean;
|
|
fFields: TDAFieldCollection;
|
|
fLogicalName : string;
|
|
fOnAfterOpen: TDAAfterOpenDatasetEvent;
|
|
fOnBeforeOpen: TDABeforeOpenDatasetEvent;
|
|
fOnOpenError: TDAOpenDatasetErrorEvent;
|
|
|
|
protected
|
|
function IsNeedCreateFieldDefs: Boolean; virtual;
|
|
procedure CreateFieldDefs;virtual;
|
|
function IsNeedToFixFMTBCDIssue: Boolean; virtual;
|
|
procedure FixFMTBCDIssue;
|
|
// To be overridden
|
|
function DoGetRecordCount: integer; dynamic;
|
|
function DoGetActive: boolean; dynamic;
|
|
procedure DoSetActive(Value: boolean); dynamic;
|
|
function DoGetBOF: boolean; dynamic;
|
|
function DoGetEOF: boolean; dynamic;
|
|
|
|
procedure DoNext; dynamic;
|
|
|
|
function DoLocate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; dynamic;
|
|
|
|
// IDADataset
|
|
function GetRecordCount: integer; safecall;
|
|
function GetFieldCount: integer; safecall;
|
|
function GetFields: TDAFieldCollection; safecall;
|
|
function GetActive: boolean; safecall;
|
|
procedure SetActive(Value: boolean); safecall;
|
|
function GetBOF: boolean; safecall;
|
|
function GetEOF: boolean; safecall;
|
|
function GetFieldValues(Index: integer): Variant; safecall;
|
|
function GetNames(Index: integer): string; safecall;
|
|
function GetIsEmpty : boolean; safecall;
|
|
function GetState : TDatasetState; safecall;
|
|
|
|
procedure Open; safecall;
|
|
procedure Close; safecall;
|
|
|
|
procedure EnableControls; safecall;
|
|
procedure DisableControls; safecall;
|
|
|
|
procedure Next; safecall;
|
|
|
|
procedure Refresh; safecall;
|
|
|
|
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; safecall;
|
|
function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; safecall;
|
|
|
|
function FieldByName(const aName: string): TDAField; safecall;
|
|
function FindField(const aName: string): TDAField; safecall;
|
|
|
|
function GetBookMark: pointer; safecall;
|
|
procedure GotoBookmark(Bookmark: TBookmark); safecall;
|
|
procedure FreeBookmark(Bookmark: TBookmark); safecall;
|
|
function GetLogicalName : string; safecall;
|
|
procedure SetLogicalName(aName : string); safecall;
|
|
|
|
function GetOnAfterOpen: TDAAfterOpenDatasetEvent; safecall;
|
|
function GetOnBeforeOpen: TDABeforeOpenDatasetEvent; safecall;
|
|
procedure SetOnAfterOpen(const Value: TDAAfterOpenDatasetEvent); safecall;
|
|
procedure SetOnBeforeOpen(const Value: TDABeforeOpenDatasetEvent); safecall;
|
|
function GetOnOpenError: TDAOpenDatasetErrorEvent; safecall;
|
|
procedure SetOnOpenError(const Value: TDAOpenDatasetErrorEvent); safecall;
|
|
|
|
function GetRowRecIdValue: integer;
|
|
function GetCurrentRecIdValue: integer;
|
|
procedure SetCurrentRecIdValue(Value: integer);
|
|
procedure EnableConstraints; safecall;
|
|
procedure DisableConstraints; safecall;
|
|
public
|
|
constructor Create(aConnection: TDAEConnection; const aName: string = ''); override;
|
|
destructor Destroy; override;
|
|
end;
|
|
{$WARN SYMBOL_DEPRECATED ON}
|
|
|
|
TDAEDatasetClass = class of TDAEDataset;
|
|
|
|
{$WARN SYMBOL_DEPRECATED OFF}
|
|
{ TDAEStoredProcedure }
|
|
TDAEStoredProcedure = class(TDAESQLCommand, IDASQLCommand, IDAStoredProcedure)
|
|
private
|
|
protected
|
|
// Internal
|
|
procedure DoPrepare(Value: boolean); override;
|
|
procedure RefreshParams; override; safecall;
|
|
|
|
// IDAStoredProcedure
|
|
function GetStoredProcedureName: string; virtual; safecall; abstract;
|
|
procedure SetStoredProcedureName(const Name: string); virtual; safecall; 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; safecall;
|
|
procedure SetConnectionPool(const Value: IDAConnectionPool); safecall;
|
|
// 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; safecall;
|
|
function GetConnectionProperties(const aPropertyName: string): Variant; safecall;
|
|
procedure SetConnectionProperties(const aPropertyName: string; const aValue: Variant); safecall;
|
|
|
|
// IDATestableObject
|
|
procedure Test; virtual; safecall;
|
|
|
|
// IDAConnection
|
|
function GetConnectionString: string; safecall;
|
|
procedure SetConnectionString(Value: string); safecall;
|
|
function GetConnected: boolean; virtual; safecall;
|
|
procedure SetConnected(Value: boolean); virtual; safecall;
|
|
function GetName: string; safecall;
|
|
|
|
function GetOnAfterExecuteCommand: TDAAfterExecuteCommandEvent; safecall;
|
|
function GetOnAfterOpenDataset: TDAAfterOpenDatasetEvent; safecall;
|
|
function GetOnBeforeExecuteCommand: TDABeforeExecuteCommandEvent; safecall;
|
|
function GetOnBeforeOpenDataset: TDABeforeOpenDatasetEvent; safecall;
|
|
function GetOnExecuteCommandError: TDAExecuteCommandErrorEvent; safecall;
|
|
function GetOnOpenDatasetError: TDAOpenDatasetErrorEvent; safecall;
|
|
procedure SetOnAfterExecuteCommand(const Value: TDAAfterExecuteCommandEvent); safecall;
|
|
procedure SetOnAfterOpenDataset(const Value: TDAAfterOpenDatasetEvent); safecall;
|
|
procedure SetOnBeforeExecuteCommand(const Value: TDABeforeExecuteCommandEvent); safecall;
|
|
procedure SetOnBeforeOpenDataset(const Value: TDABeforeOpenDatasetEvent); safecall;
|
|
procedure SetOnExecuteCommandError(const Value: TDAExecuteCommandErrorEvent); safecall;
|
|
procedure SetOnOpenDatasetError(const Value: TDAOpenDatasetErrorEvent); safecall;
|
|
|
|
procedure Open(const aUserID: string = ''; const aPassword: string = ''); safecall;
|
|
procedure Close; safecall;
|
|
|
|
// UserID/Password
|
|
function GetUserID: string; virtual; safecall;
|
|
procedure SetUserID(const Value: string); virtual; safecall;
|
|
function GetPassword: string; virtual; safecall;
|
|
procedure SetPassword(const Value: string); virtual; safecall;
|
|
|
|
function BeginTransaction: integer; safecall;
|
|
procedure CommitTransaction; safecall;
|
|
procedure RollbackTransaction; safecall;
|
|
function GetInTransaction: boolean; safecall;
|
|
|
|
procedure GetTableNames(out List: IROStrings); safecall;
|
|
procedure GetViewNames(out List: IROStrings); safecall;
|
|
procedure GetStoredProcedureNames(out List: IROStrings); safecall;
|
|
procedure GetTableFields(const aTableName: string; out Fields: TDAFieldCollection); safecall;
|
|
procedure GetQueryFields(const aSQL: string; aParamsIfNeeded: TDAParamCollection; out Fields: TDAFieldCollection); safecall;
|
|
procedure GetViewFields(const aViewName: string; out Fields: TDAFieldCollection); safecall;
|
|
procedure GetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection); safecall;
|
|
procedure GetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); safecall;
|
|
|
|
|
|
function GetSPSelectSyntax(HasArguments: Boolean): string; virtual; safecall;
|
|
function GetQuoteChars: TDAQuoteCharArray; virtual; safecall;
|
|
function IdentifierIsQuoted(const iIdentifier: string): boolean; virtual; safecall;
|
|
function IdentifierNeedsQuoting(const iIdentifier: string): boolean; virtual; safecall;
|
|
function QuoteIdentifierIfNeeded(const iIdentifier: string): string; virtual; safecall;
|
|
function QuoteIdentifier(const iIdentifier: string): string; virtual; safecall;
|
|
function QuoteFieldNameIfNeeded(const aTableName, aFieldName: string): string; virtual;safecall;
|
|
function QuoteFieldName(const aTableName, aFieldName: string): string; virtual; safecall;
|
|
|
|
function NewCommand(const Text: string; CommandType: TDASQLStatementType; const aCommandName: string = ''): IDASQLCommand; virtual; safecall;
|
|
function NewDataset(const SQL: string; const aDatasetName: string = ''): IDADataset; virtual; safecall;
|
|
function GetLastAutoInc(const GeneratorName: string = ''): integer; safecall;
|
|
|
|
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; safecall;
|
|
function GetConnectionType: string; safecall;
|
|
property ConnectionType: string read GetConnectionType;
|
|
function GetQueryBuilder: TDAQueryBuilder; virtual; safecall;
|
|
function GetWhereBuilder: TDASQLWhereBuilder; virtual; safecall;
|
|
function GetUseMacroProcessor: Boolean; safecall;
|
|
procedure SetUseMacroProcessor(Value:Boolean); safecall;
|
|
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; safecall; abstract;
|
|
function GetDescription: string; virtual; safecall; abstract;
|
|
function GetMajVersion: byte; virtual; safecall;
|
|
function GetMinVersion: byte; virtual; safecall;
|
|
|
|
procedure GetAuxDrivers(out List: IROStrings); virtual; safecall;
|
|
procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); virtual; safecall;
|
|
function GetDefaultConnectionType(const AuxDriver: string): string; virtual; safecall;
|
|
|
|
procedure SetTraceOptions(TraceActive: boolean; TraceFlags: TDATraceOptions; Callback: TDALogTraceEvent); safecall;
|
|
|
|
function NewConnection(const aName: string = ''; const aConnectionType: string = ''): IDAConnection; overload; {deprecated;} safecall;
|
|
function NewConnection(const aConnectionManager: IDAConnectionManager; aConnectionDefinition: TDAConnection): IDAConnection; overload; safecall;
|
|
|
|
procedure Initialize; virtual; safecall;
|
|
procedure Finalize; virtual; safecall;
|
|
|
|
function GetAvailableDriverOptions: TDAAvailableDriverOptions; virtual; safecall;
|
|
function GetDefaultCustomParameters: string; virtual; safecall;
|
|
|
|
{ IDADriver30 }
|
|
function GetDriverHelp(aType: TDADriverHelpType): string;
|
|
public
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TDAEDriverClass = class of TDAEDriver;
|
|
|
|
{ TDADriverReference }
|
|
TDADriverReference = class(TComponent)
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
function DAHandleSafeCallException(aObject:TObject; ExceptObject: TObject; ExceptAddr: Pointer): HResult;
|
|
{$ENDIF MSWINDOWS}
|
|
function Engine_GetDatabaseNames(aConnection:TDAEConnection; aMasterDatabase, aGetDatabaseNamesSQL: String): IROStrings;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF MSWINDOWS}Windows,{$ENDIF} Variants,
|
|
TypInfo, uDAHelpers, uROClient, uDASQL92QueryBuilder, uROBinaryHelpers;
|
|
|
|
function Engine_GetDatabaseNames(aConnection:TDAEConnection; aMasterDatabase, aGetDatabaseNamesSQL: String): IROStrings;
|
|
var
|
|
connStrParser : TDAConnectionStringParser;
|
|
conn : IDAConnection;
|
|
ds : IDAdataset;
|
|
begin
|
|
Result := NewROStrings;
|
|
connStrParser := TDAConnectionStringParser.Create((aConnection as IDAConnection).ConnectionString);
|
|
try
|
|
connStrParser.Database := aMasterDatabase;
|
|
|
|
conn := TDAEConnectionClass(aConnection.ClassType).Create(aConnection.Driver);
|
|
conn.ConnectionString := connStrParser.BuildString;
|
|
conn.Open;
|
|
|
|
ds := conn.NewDataset(aGetDatabaseNamesSQL);
|
|
ds.Open;
|
|
|
|
while not ds.EOF do begin
|
|
result.Add(VarToStr(ds.FieldValues[0]));
|
|
ds.Next;
|
|
end;
|
|
finally
|
|
connStrParser.Free;
|
|
conn := nil;
|
|
ds := nil;
|
|
end;
|
|
end;
|
|
|
|
{ TDAEDriver }
|
|
|
|
destructor TDAEDriver.Destroy;
|
|
begin
|
|
SetTraceOptions(FALSE, [], nil);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAEDriver.Initialize;
|
|
begin
|
|
end;
|
|
|
|
procedure TDAEDriver.Finalize;
|
|
begin
|
|
|
|
end;
|
|
|
|
function TDAEDriver.GetMajVersion: byte;
|
|
begin
|
|
result := 1
|
|
end;
|
|
|
|
function TDAEDriver.GetMinVersion: byte;
|
|
begin
|
|
result := 0
|
|
end;
|
|
|
|
function TDAEDriver.NewConnection(const aName: string = '';const aConnectionType: string = ''): IDAConnection;
|
|
var
|
|
conn: TDAEConnection;
|
|
begin
|
|
conn := GetConnectionClass.Create(Self, aName);
|
|
conn.FConnectionType := aConnectionType;
|
|
CustomizeConnectionObject(conn); // In some cases the driver might need to do additional customization
|
|
|
|
result := conn;
|
|
end;
|
|
|
|
function TDAEDriver.NewConnection(const aConnectionManager: IDAConnectionManager; aConnectionDefinition: TDAConnection): IDAConnection;
|
|
var
|
|
conn: TDAEConnection;
|
|
begin
|
|
conn := GetConnectionClass.Create(Self, aConnectionDefinition.Name);
|
|
conn.fConnectionType := aConnectionDefinition.ConnectionType;
|
|
conn.fConnectionManager := aConnectionManager;
|
|
conn.fConnectionDefinition := aConnectionDefinition;
|
|
CustomizeConnectionObject(conn); // In some cases the driver might need to do additional customization
|
|
|
|
result := conn;
|
|
end;
|
|
|
|
function TDAEDriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
|
|
begin
|
|
//result := [doAuxDriver,doServerName,doDatabaseName,doLogin,doCustom];
|
|
result := [doServerName, doDatabaseName, doLogin];
|
|
end;
|
|
|
|
function TDAEDriver.GetDefaultConnectionType(const AuxDriver: string): string;
|
|
begin
|
|
result := '';
|
|
end;
|
|
|
|
function TDAEDriver.GetDefaultCustomParameters: string;
|
|
begin
|
|
result := '';
|
|
end;
|
|
|
|
procedure TDAEDriver.SetTraceOptions(TraceActive: boolean; TraceFlags: TDATraceOptions; Callback: TDALogTraceEvent);
|
|
begin
|
|
if (csDesigning in ComponentState) then Exit;
|
|
|
|
DoSetTraceOptions(TraceActive, TraceFlags, Callback);
|
|
end;
|
|
|
|
procedure TDAEDriver.CustomizeConnectionObject(aConnection: TDAEConnection);
|
|
begin
|
|
end;
|
|
|
|
procedure TDAEDriver.DoSetTraceOptions(TraceActive: boolean;
|
|
TraceFlags: TDATraceOptions; Callback: TDALogTraceEvent);
|
|
begin
|
|
end;
|
|
|
|
procedure TDAEDriver.GetAuxDrivers(out List: IROStrings);
|
|
begin
|
|
List := NewROStrings();
|
|
end;
|
|
|
|
procedure TDAEDriver.GetAuxParams(const AuxDriver: string; out List: IROStrings);
|
|
begin
|
|
List := NewROStrings();
|
|
end;
|
|
|
|
function TDAEDriver.GetDriverHelp(aType: TDADriverHelpType): string;
|
|
begin
|
|
result := LoadHtmlFromResource(hInstance, 'DRIVER_HELP');
|
|
end;
|
|
|
|
{ TDAEConnection }
|
|
|
|
constructor TDAEConnection.Create(aDriver: TDAEDriver; aName: string = '');
|
|
begin
|
|
inherited Create;
|
|
|
|
fName := aName;
|
|
fDriver := aDriver;
|
|
fConnectionObject := CreateConnectionObject;
|
|
FUseMacroProcessor := True;
|
|
end;
|
|
|
|
destructor TDAEConnection.Destroy;
|
|
begin
|
|
if Assigned(fConnectionObject) then begin
|
|
try
|
|
if fConnectionObject.Connected then fConnectionObject.Close;
|
|
except
|
|
end;
|
|
FreeAndNIL(fConnectionObject);
|
|
end;
|
|
|
|
if Assigned(fMacroProcessor) then fMacroProcessor.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TDAEConnection.GetConnected: boolean;
|
|
begin
|
|
result := assigned(fConnectionObject) and fConnectionObject.Connected;
|
|
end;
|
|
|
|
function TDAEConnection.GetConnectionString: string;
|
|
begin
|
|
result := fConnectionString;
|
|
end;
|
|
|
|
procedure TDAEConnection.SetConnected(Value: boolean);
|
|
begin
|
|
if fConnectionObject <> nil then
|
|
fConnectionObject.Connected := Value;
|
|
end;
|
|
|
|
procedure TDAEConnection.SetConnectionString(Value: string);
|
|
begin
|
|
if (Value = fConnectionString) then Exit;
|
|
|
|
ApplyConnectionString(Value, fConnectionObject);
|
|
end;
|
|
|
|
function TDAEConnection.GetConnectionObject: TObject;
|
|
begin
|
|
result := fConnectionObject;
|
|
end;
|
|
|
|
function TDAEConnection.GetConnectionProperties(
|
|
const aPropertyName: string): Variant;
|
|
begin
|
|
if assigned(fConnectionObject) then
|
|
result := GetPropValue(fConnectionObject, aPropertyName, FALSE)
|
|
else
|
|
result := Unassigned;
|
|
end;
|
|
|
|
procedure TDAEConnection.SetConnectionProperties(
|
|
const aPropertyName: string; const aValue: Variant);
|
|
begin
|
|
if assigned(fConnectionObject) then
|
|
SetPropValue(fConnectionObject, aPropertyName, aValue);
|
|
end;
|
|
|
|
procedure TDAEConnection.Close;
|
|
begin
|
|
SetConnected(FALSE); // Exceptions are handled there
|
|
end;
|
|
|
|
procedure TDAEConnection.Open(const aUserID: string = ''; const aPassword: string = '');
|
|
begin
|
|
if (aUserID <> '') then UserID := aUserID;
|
|
if (aPassword <> '') then Password := aPassword;
|
|
|
|
SetConnected(TRUE); // Exceptions are handled there
|
|
end;
|
|
|
|
function TDAEConnection.CreateConnectionObject: TCustomConnection;
|
|
begin
|
|
result := CreateCustomConnection;
|
|
end;
|
|
|
|
function TDAEConnection.NewDataset(const SQL: string; const aDatasetName: string = ''): IDADataset;
|
|
begin
|
|
result := GetDatasetClass.Create(Self, aDatasetName);
|
|
result.SQL := SQL;
|
|
|
|
AssignDatasetEventHandlers(result); // Propagates the event handlers to all datasets
|
|
end;
|
|
|
|
function TDAEConnection.NewCommand(const Text: string; CommandType: TDASQLStatementType; const aCommandName: string = ''): IDASQLCommand;
|
|
var
|
|
sp: IDAStoredProcedure;
|
|
ds: IDADataset;
|
|
begin
|
|
result := nil;
|
|
|
|
case CommandType of
|
|
stStoredProcedure: begin
|
|
sp := GetStoredProcedureClass.Create(Self, aCommandName);
|
|
sp.StoredProcedureName := Text;
|
|
|
|
result := sp;
|
|
end;
|
|
stSQL: begin
|
|
ds := GetDatasetClass.Create(Self, aCommandName);
|
|
ds.SQL := Text;
|
|
result := ds;
|
|
end;
|
|
end;
|
|
|
|
if Result <> nil then
|
|
Result.RefreshParams;
|
|
|
|
AssignCommandEventHandlers(result); // Propagates the event handlers to all commands
|
|
end;
|
|
|
|
function TDAEConnection.BeginTransaction: integer;
|
|
begin
|
|
result := -1;
|
|
|
|
DoBeginTransaction;
|
|
end;
|
|
|
|
procedure TDAEConnection.CommitTransaction;
|
|
begin
|
|
DoCommitTransaction;
|
|
end;
|
|
|
|
procedure TDAEConnection.RollbackTransaction;
|
|
begin
|
|
DoRollbackTransaction;
|
|
end;
|
|
|
|
procedure TDAEConnection.GetStoredProcedureNames(out List: IROStrings);
|
|
begin
|
|
DoGetStoredProcedureNames(List);
|
|
end;
|
|
|
|
procedure TDAEConnection.GetStoredProcedureParams(
|
|
const aStoredProcedureName: string; out Params: TDAParamCollection);
|
|
begin
|
|
DoGetStoredProcedureParams(aStoredProcedureName, Params);
|
|
end;
|
|
|
|
procedure TDAEConnection.GetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection);
|
|
begin
|
|
DoGetForeignKeys(ForeignKeys);
|
|
end;
|
|
|
|
procedure TDAEConnection.GetTableFields(const aTableName: string;
|
|
out Fields: TDAFieldCollection);
|
|
begin
|
|
DoGetTableFields(aTableName, Fields);
|
|
end;
|
|
|
|
procedure TDAEConnection.GetQueryFields(const aSQL: string; aParamsIfNeeded: TDAParamCollection; out Fields: TDAFieldCollection);
|
|
begin
|
|
DoGetQueryFields(aSQL, aParamsIfNeeded, Fields);
|
|
end;
|
|
|
|
procedure TDAEConnection.GetTableNames(out List: IROStrings);
|
|
begin
|
|
DoGetTableNames(List);
|
|
end;
|
|
|
|
procedure TDAEConnection.GetViewFields(const aViewName: string;
|
|
out Fields: TDAFieldCollection);
|
|
begin
|
|
DoGetViewFields(aViewName, Fields);
|
|
end;
|
|
|
|
procedure TDAEConnection.GetViewNames(out List: IROStrings);
|
|
begin
|
|
DoGetViewNames(List);
|
|
end;
|
|
|
|
function TDAEConnection.GetWhereBuilder: TDASQLWhereBuilder;
|
|
begin
|
|
Result:= TDASQL92WhereBuilder.Create(Self);
|
|
end;
|
|
|
|
function TDAEConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
result := nil;
|
|
end;
|
|
|
|
function TDAEConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
result := nil;
|
|
end;
|
|
|
|
procedure TDAEConnection.DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection);
|
|
var
|
|
qry: IDADataset;
|
|
begin
|
|
Fields := TDAFieldCollection.Create(nil);
|
|
qry := GetDatasetClass.Create(Self);
|
|
try
|
|
qry.SQL := 'SELECT * FROM ' + QuoteIdentifierIfNeeded(aTableName) + ' WHERE 1=0';
|
|
qry.Open;
|
|
Fields.Assign(qry.Fields);
|
|
finally
|
|
qry := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEConnection.DoGetQueryFields(const aSQL: string; aParamsIfNeeded: TDAParamCollection; out Fields: TDAFieldCollection);
|
|
var
|
|
qry: IDADataset;
|
|
begin
|
|
Fields := TDAFieldCollection.Create(nil);
|
|
qry := GetDatasetClass.Create(Self);
|
|
try
|
|
qry.SQL := aSQL;
|
|
if assigned(aParamsIfNeeded) then
|
|
qry.Params.AssignParamCollection(aParamsIfNeeded);
|
|
qry.Open;
|
|
Fields.Assign(qry.Fields);
|
|
finally
|
|
qry := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEConnection.DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection);
|
|
var
|
|
cmd: IDASQLCommand;
|
|
begin
|
|
//Params := nil;
|
|
cmd := NewCommand(aStoredProcedureName, stStoredProcedure);
|
|
cmd.RefreshParams;
|
|
|
|
{if (Params = nil) then} Params := TDAParamCollection.Create(nil);
|
|
Params.AssignParamCollection(cmd.Params);
|
|
end;
|
|
|
|
procedure TDAEConnection.DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection);
|
|
begin
|
|
ForeignKeys := TDADriverForeignKeyCollection.Create(nil);
|
|
end;
|
|
|
|
function TDAEConnection.GetName: string;
|
|
begin
|
|
result := fName;
|
|
end;
|
|
|
|
procedure TDAEConnection.DoGetViewFields(const aViewName: string;
|
|
out Fields: TDAFieldCollection);
|
|
begin
|
|
DoGetTableFields(aViewName, Fields);
|
|
end;
|
|
|
|
function TDAEConnection.GetQuoteChars: TDAQuoteCharArray;
|
|
begin
|
|
result[0] := '"';
|
|
result[1] := '"';
|
|
end;
|
|
|
|
procedure TDAEConnection.DoGetViewNames(out List: IROStrings);
|
|
begin
|
|
List := NewROStrings; // Changed from NIL.
|
|
end;
|
|
|
|
procedure TDAEConnection.DoGetStoredProcedureNames(out List: IROStrings);
|
|
begin
|
|
List := NewROStrings; // Changed from NIL.
|
|
end;
|
|
|
|
procedure TDAEConnection.DoGetTableNames(out List: IROStrings);
|
|
begin
|
|
List := NewROStrings; // Changed from NIL.
|
|
end;
|
|
|
|
function TDAEConnection.GetInTransaction: boolean;
|
|
begin
|
|
result := DoGetInTransaction;
|
|
end;
|
|
|
|
function TDAEConnection.GetPassword: string;
|
|
begin
|
|
result := fPassword;
|
|
end;
|
|
|
|
function TDAEConnection.GetUserID: string;
|
|
begin
|
|
result := fUserID;
|
|
end;
|
|
|
|
procedure TDAEConnection.SetPassword(const Value: string);
|
|
begin
|
|
fPassword := Value;
|
|
|
|
ApplyConnectionString(GetConnectionString, ConnectionObject); // Refreshes it
|
|
end;
|
|
|
|
procedure TDAEConnection.SetUserID(const Value: string);
|
|
begin
|
|
fUserID := Value;
|
|
|
|
ApplyConnectionString(GetConnectionString, ConnectionObject); // Refreshes it
|
|
end;
|
|
|
|
function TDAEConnection.GetLastAutoInc(
|
|
const GeneratorName: string): integer;
|
|
begin
|
|
result := DoGetLastAutoInc(GeneratorName);
|
|
end;
|
|
|
|
function TDAEConnection.DoGetLastAutoInc(
|
|
const GeneratorName: string): integer;
|
|
begin
|
|
result := -1;
|
|
end;
|
|
|
|
function TDAEConnection.IdentifierIsQuoted(const iIdentifier: string): boolean;
|
|
var
|
|
lQuoteChars: TDAQuoteCharArray;
|
|
lLength:integer;
|
|
begin
|
|
lQuoteChars := GetQuoteChars();
|
|
lLength := Length(iIdentifier);
|
|
result := (lLength > 2) and (iIdentifier[1] = lQuoteChars[0]) and (iIdentifier[lLength] = lQuoteChars[1]);
|
|
end;
|
|
|
|
function TDAEConnection.IdentifierNeedsQuoting(const iIdentifier: string): boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := false;
|
|
if IdentifierIsQuoted(iIdentifier) then Exit;
|
|
|
|
for i := 1 to Length(iIdentifier) do begin
|
|
if not (iIdentifier[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '.']) then begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDAEConnection.QuoteIdentifierIfNeeded(const iIdentifier: string): string;
|
|
begin
|
|
if IdentifierNeedsQuoting(iIdentifier) then
|
|
result := QuoteIdentifier(iIdentifier)
|
|
else
|
|
result := iIdentifier;
|
|
end;
|
|
|
|
function TDAEConnection.QuoteIdentifier(const iIdentifier: string): string;
|
|
var
|
|
lQuoteChars: TDAQuoteCharArray;
|
|
begin
|
|
lQuoteChars := GetQuoteChars();
|
|
if (Pos('.', iIdentifier)>0) then
|
|
result := lQuoteChars[0] + StringReplace(iIdentifier, '.', lQuoteChars[1]+'.'+ lQuoteChars[0], [rfReplaceAll]) + lQuoteChars[1]
|
|
else
|
|
result := lQuoteChars[0] + iIdentifier + lQuoteChars[1];
|
|
end;
|
|
|
|
function TDAEConnection.CreateMacroProcessor: TDASQLMacroProcessor;
|
|
begin
|
|
{$WARNINGS OFF}
|
|
result := TDASQLMacroProcessor.Create;
|
|
{$WARNINGS ON}
|
|
end;
|
|
|
|
procedure TDAEConnection.ApplyConnectionString(
|
|
const aConnectionString: string; aConnectionObject: TCustomConnection);
|
|
var
|
|
i: Integer;
|
|
lParamName: String;
|
|
lConnStrParser: TDAConnectionStringParser;
|
|
begin
|
|
FreeAndNIL(fMacroProcessor);
|
|
|
|
lConnStrParser := TDAConnectionStringParser.Create(aConnectionString);
|
|
try
|
|
fConnectionString := aConnectionString;
|
|
DoApplyConnectionString(lConnStrParser, aConnectionObject);
|
|
//with lConnStrParser do
|
|
if aConnectionObject <> nil then
|
|
begin
|
|
for i := 0 to lConnStrParser.AuxParamsCount - 1 do begin
|
|
lParamName := lConnStrParser.AuxParamNames[i];
|
|
if Assigned(GetPropInfo(aConnectionObject, lParamName)) then begin
|
|
SetConnectionProperties(lParamName, lConnStrParser.AuxParams[lParamName]);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
lConnStrParser.Free;
|
|
end;
|
|
|
|
fMacroProcessor := CreateMacroProcessor;
|
|
end;
|
|
|
|
procedure TDAEConnection.DoApplyConnectionString(
|
|
aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
|
|
begin
|
|
if (aConnectionObject <> nil) then aConnectionObject.Close;
|
|
end;
|
|
|
|
function TDAEConnection.GetOnAfterExecuteCommand: TDAAfterExecuteCommandEvent;
|
|
begin
|
|
result := fOnAfterExecuteCommand
|
|
end;
|
|
|
|
function TDAEConnection.GetOnAfterOpenDataset: TDAAfterOpenDatasetEvent;
|
|
begin
|
|
result := fOnAfterOpenDataset
|
|
end;
|
|
|
|
function TDAEConnection.GetOnBeforeExecuteCommand: TDABeforeExecuteCommandEvent;
|
|
begin
|
|
result := fOnBeforeExecuteCommand
|
|
end;
|
|
|
|
function TDAEConnection.GetOnBeforeOpenDataset: TDABeforeOpenDatasetEvent;
|
|
begin
|
|
result := fOnBeforeOpenDataset
|
|
end;
|
|
|
|
function TDAEConnection.GetOnExecuteCommandError: TDAExecuteCommandErrorEvent;
|
|
begin
|
|
result := fOnExecuteCommandError
|
|
end;
|
|
|
|
function TDAEConnection.GetOnOpenDatasetError: TDAOpenDatasetErrorEvent;
|
|
begin
|
|
result := fOnOpenDatasetError
|
|
end;
|
|
|
|
procedure TDAEConnection.SetOnAfterExecuteCommand(
|
|
const Value: TDAAfterExecuteCommandEvent);
|
|
begin
|
|
fOnAfterExecuteCommand := Value;
|
|
end;
|
|
|
|
procedure TDAEConnection.SetOnAfterOpenDataset(
|
|
const Value: TDAAfterOpenDatasetEvent);
|
|
begin
|
|
fOnAfterOpenDataset := Value;
|
|
end;
|
|
|
|
procedure TDAEConnection.SetOnBeforeExecuteCommand(
|
|
const Value: TDABeforeExecuteCommandEvent);
|
|
begin
|
|
fOnBeforeExecuteCommand := Value;
|
|
end;
|
|
|
|
procedure TDAEConnection.SetOnBeforeOpenDataset(
|
|
const Value: TDABeforeOpenDatasetEvent);
|
|
begin
|
|
fOnBeforeOpenDataset := Value;
|
|
end;
|
|
|
|
procedure TDAEConnection.SetOnExecuteCommandError(
|
|
const Value: TDAExecuteCommandErrorEvent);
|
|
begin
|
|
fOnExecuteCommandError := Value;
|
|
end;
|
|
|
|
procedure TDAEConnection.SetOnOpenDatasetError(
|
|
const Value: TDAOpenDatasetErrorEvent);
|
|
begin
|
|
fOnOpenDatasetError := Value;
|
|
end;
|
|
|
|
procedure TDAEConnection.AssignCommandEventHandlers(
|
|
const aCommand: IDASQLCommand);
|
|
begin
|
|
if aCommand=NIL then Exit;
|
|
aCommand.OnBeforeExecute := fOnBeforeExecuteCommand;
|
|
aCommand.OnAfterExecute := fOnAfterExecuteCommand;
|
|
aCommand.OnExecuteError := fOnExecuteCommandError;
|
|
end;
|
|
|
|
procedure TDAEConnection.AssignDatasetEventHandlers(
|
|
const aDataset: IDADataset);
|
|
begin
|
|
if aDataset=NIL then Exit;
|
|
aDataset.OnBeforeOpen := fOnBeforeOpenDataset;
|
|
aDataset.OnAfterOpen := fOnAfterOpenDataset;
|
|
aDataset.OnOpenError := fOnOpenDatasetError;
|
|
end;
|
|
|
|
procedure TDAEConnection.Test;
|
|
begin
|
|
Open;
|
|
Close;
|
|
end;
|
|
|
|
function TDAEConnection.GetSPSelectSyntax(HasArguments: Boolean): string;
|
|
begin
|
|
Result := 'EXEC {0} {1}';
|
|
end;
|
|
|
|
function TDAEConnection.GetMacroProcessor: TDASQLMacroProcessor;
|
|
begin
|
|
if FUseMacroProcessor then
|
|
result := fMacroProcessor
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TDAEConnection._Release: Integer;
|
|
begin
|
|
Result := InterlockedDecrement(FRefCount);
|
|
if (Result = 0) and not (fReleasing) then begin
|
|
fReleasing := True;
|
|
InterlockedIncrement(fRefCount);
|
|
if assigned(fConnectionPool) then
|
|
fConnectionPool.ReleaseConnection(self);
|
|
Result := InterlockedDecrement(fRefCount);
|
|
fReleasing := False;
|
|
end;
|
|
if Result = 0 then
|
|
Destroy;
|
|
end;
|
|
|
|
function TDAEConnection.GetConnectionPool: IDAConnectionPool;
|
|
begin
|
|
result := fConnectionPool;
|
|
end;
|
|
|
|
procedure TDAEConnection.SetConnectionPool(const Value: IDAConnectionPool);
|
|
begin
|
|
fConnectionPool := Value;
|
|
end;
|
|
|
|
function TDAEConnection.QuoteFieldName(const aTableName,
|
|
aFieldName: string): string;
|
|
begin
|
|
Result:= QuoteIdentifier(aFieldName);
|
|
end;
|
|
|
|
function TDAEConnection.QuoteFieldNameIfNeeded(const aTableName,
|
|
aFieldName: string): string;
|
|
begin
|
|
if IdentifierNeedsQuoting(aFieldName) then
|
|
result := QuoteFieldName(aTableName,aFieldName)
|
|
else
|
|
result := aFieldName;
|
|
end;
|
|
|
|
function TDAEConnection.isAlive: Boolean;
|
|
begin
|
|
Result:= (ConnectionObject <> nil) and ConnectionObject.Connected;
|
|
end;
|
|
|
|
function TDAEConnection.GetConnectionType: string;
|
|
begin
|
|
Result:= FConnectionType;
|
|
end;
|
|
|
|
function TDAEConnection.GetQueryBuilder: TDAQueryBuilder;
|
|
begin
|
|
Result:= TDASQL92QueryBuilder.Create;
|
|
Result.Connection:=Self;
|
|
end;
|
|
|
|
function TDAEConnection.GetUseMacroProcessor: Boolean;
|
|
begin
|
|
Result := FUseMacroProcessor;
|
|
end;
|
|
|
|
procedure TDAEConnection.SetUseMacroProcessor(Value: Boolean);
|
|
begin
|
|
FUseMacroProcessor := Value;
|
|
end;
|
|
|
|
function TDAEConnection.QueryInterface(const IID: TGUID; out Obj): HResult;
|
|
begin
|
|
Result:= E_NOINTERFACE;
|
|
if IsEqualGUID(IID, IDAHasMacroProcessor) then begin
|
|
if not FUseMacroProcessor then Exit;
|
|
end;
|
|
Result := inherited QueryInterface(IID, Obj)
|
|
end;
|
|
|
|
{ TDAEDataset }
|
|
|
|
constructor TDAEDataset.Create(aConnection: TDAEConnection; const aName: string = '');
|
|
begin
|
|
inherited;
|
|
|
|
fLogicalName := aName;
|
|
if (fLogicalName='')
|
|
then fLogicalName := NewGuidAsString;
|
|
|
|
fChanged := true;
|
|
fFields := TDAFieldCollection.Create(nil);
|
|
{$WARN SYMBOL_DEPRECATED OFF}
|
|
GetWhere.Fields := fFields; // So it can find the mappings!
|
|
{$WARN SYMBOL_DEPRECATED ON}
|
|
end;
|
|
|
|
destructor TDAEDataset.Destroy;
|
|
begin
|
|
FreeAndNil(fDataset);
|
|
FreeAndNil(fFields);
|
|
FreeAndNil(fWhere);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TDAEDataset.GetActive: boolean;
|
|
begin
|
|
result := DoGetActive
|
|
end;
|
|
|
|
function TDAEDataset.GetBOF: boolean;
|
|
begin
|
|
result := DoGetBOF
|
|
end;
|
|
|
|
function TDAEDataset.GetEOF: boolean;
|
|
begin
|
|
result := DoGetEOF;
|
|
end;
|
|
|
|
function TDAEDataset.GetFieldCount: integer;
|
|
begin
|
|
result := fFields.Count;
|
|
end;
|
|
|
|
function TDAEDataset.GetRecordCount: integer;
|
|
begin
|
|
result := DoGetRecordCount;
|
|
end;
|
|
|
|
function TDAEDataset.Locate(const KeyFields: string;
|
|
const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
|
begin
|
|
result := DoLocate(KeyFields, KeyValues, Options);
|
|
end;
|
|
|
|
procedure TDAEDataset.Next;
|
|
begin
|
|
DoNext;
|
|
end;
|
|
|
|
procedure TDAEDataset.Open;
|
|
begin
|
|
SetActive(TRUE); // Handles the exception there
|
|
end;
|
|
|
|
procedure TDAEDataset.Close;
|
|
begin
|
|
SetActive(FALSE); // Handles the exception there
|
|
end;
|
|
|
|
procedure TDAEDataset.SetActive(Value: boolean);
|
|
begin
|
|
DoSetActive(Value);
|
|
end;
|
|
|
|
function TDAEDataset.GetFields: TDAFieldCollection;
|
|
begin
|
|
result := fFields
|
|
end;
|
|
|
|
function TDAEDataset.DoGetActive: boolean;
|
|
begin
|
|
result := fDataset.Active
|
|
end;
|
|
|
|
function TDAEDataset.DoGetBOF: boolean;
|
|
begin
|
|
result := fDataset.BOF
|
|
end;
|
|
|
|
function TDAEDataset.DoGetEOF: boolean;
|
|
begin
|
|
result := fDataset.EOF
|
|
end;
|
|
|
|
function TDAEDataset.DoGetRecordCount: integer;
|
|
begin
|
|
result := fDataset.RecordCount
|
|
end;
|
|
|
|
function TDAEDataset.DoLocate(const KeyFields: string;
|
|
const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
|
begin
|
|
result := fDataset.Locate(KeyFields, KeyValues, Options);
|
|
end;
|
|
|
|
procedure TDAEDataset.DoNext;
|
|
begin
|
|
fDataset.Next
|
|
end;
|
|
|
|
procedure TDAEDataset.DoSetActive(Value: boolean);
|
|
var
|
|
i: integer;
|
|
fld: TField;
|
|
ps: IProviderSupport;
|
|
dsparams: TParams;
|
|
mspars: IDAMustSetParams;
|
|
startTick: Cardinal;
|
|
FNeedToFixFMTBCDIssue: Boolean;
|
|
s: string;
|
|
begin
|
|
if (Value = GetActive) then Exit;
|
|
|
|
// Opens the dataset
|
|
if Value then begin
|
|
// Combines the custom WHERE statement and modifies the inner SQL
|
|
if fChanged or (fWhere.Changed) then PrepareSQLStatement;
|
|
|
|
if Assigned(fConnection.fMacroProcessor) then begin
|
|
i := fConnection.fMacroProcessor.IndexOfName('Where');
|
|
s := GenerateDynamicWhereStatement;
|
|
if i = -1 then
|
|
fConnection.fMacroProcessor.AddVariable('Where').Value:=s
|
|
else
|
|
fConnection.fMacroProcessor.Variable[i].Value:=s;
|
|
|
|
if fDynamicWhere <> nil then
|
|
For i:=0 to fDynamicWhere.Params.Count-1 do
|
|
Self.GetParams.Add.AssignField(fDynamicWhere.Params[i]);
|
|
SetSQL(fConnection.fMacroProcessor.Eval(GetSQL));
|
|
end;
|
|
|
|
|
|
// Writes the parameter values
|
|
if (fParams.Count > 0) then begin
|
|
|
|
if Supports(Self, IDAMustSetParams, mspars) then
|
|
mspars.SetParamValues(fParams)
|
|
|
|
else begin
|
|
ps := GetProviderSupport;
|
|
|
|
if not Assigned(ps) then RaiseError(err_LAMEDataset, [fDataset.ClassName]);
|
|
|
|
dsparams := ps.PSGetParams;
|
|
|
|
if not Assigned(dsparams) then RaiseError(err_LAMEDataset, [fDataset.ClassName]);
|
|
|
|
fParams.WriteValues(dsparams);
|
|
end;
|
|
end;
|
|
|
|
startTick := ROGetTickCount;
|
|
if Assigned(fOnBeforeOpen) then fOnBeforeOpen(Self);
|
|
if IsNeedCreateFieldDefs then CreateFieldDefs;
|
|
FNeedToFixFMTBCDIssue := (fDataset.FieldDefs.Count=0) and IsNeedToFixFMTBCDIssue;
|
|
// Opens the dataset
|
|
fAutoFields := (fFields.Count = 0);
|
|
try
|
|
fDataset.Open;
|
|
if FNeedToFixFMTBCDIssue then FixFMTBCDIssue;
|
|
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);
|
|
|
|
if Supports(Self, IDAMustSetParams, mspars) then
|
|
mspars.GetParamValues(fParams)
|
|
else begin
|
|
for i := 0 to fParams.Count-1 do begin
|
|
if fParams[i].ParamType in [daptOutput, daptInputOutput, daptResult] then begin
|
|
ps := GetProviderSupport;
|
|
if not Assigned(ps) then RaiseError(err_LAMEDataset, [fDataset.ClassName]);
|
|
dsparams := ps.PSGetParams;
|
|
if not Assigned(dsparams) then RaiseError(err_LAMEDataset, [fDataset.ClassName]);
|
|
fParams[i].Value := dsparams.ParamByName(fParams[i].Name).Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
if fAutoFields and (fFields.Count = 0)then begin
|
|
for i := 0 to (fDataset.FieldCount - 1) do begin
|
|
fld := fDataset.Fields[i];
|
|
with fFields.Add(fld.FieldName, intVCLTypeToDAType(fld.DataType), fld.Size) do begin
|
|
if DataType = datDecimal then begin
|
|
DecimalPrecision:= TFMTBCDField(fld).Precision;
|
|
DecimalScale:= TFMTBCDField(fld).Size;
|
|
end;
|
|
Bind(fld);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
fFields.Bind(fDataset);
|
|
end
|
|
else begin
|
|
if fAutoFields then
|
|
fFields.Clear
|
|
else
|
|
fFields.Unbind;
|
|
|
|
fDataset.Close;
|
|
end;
|
|
end;
|
|
|
|
function TDAEDataset.GetFieldValues(Index: integer): Variant;
|
|
begin
|
|
With fFields[Index] do
|
|
if (BindedField = nil) or (BindedField.IsNull) then
|
|
Result:=Null
|
|
else
|
|
case BindedField.DataType of
|
|
ftTimeStamp: result := BindedField.AsDateTime;
|
|
ftFMTBcd: Result:= BCDToVariant(BindedField.AsBCD,True);
|
|
ftBytes: Result := BindedField.Value;
|
|
else
|
|
result := fFields[Index].Value;
|
|
end;
|
|
end;
|
|
|
|
function TDAEDataset.GetNames(Index: integer): string;
|
|
begin
|
|
result := fDataset.Fields[Index].Name
|
|
end;
|
|
|
|
procedure TDAEDataset.DisableControls;
|
|
begin
|
|
fDataset.DisableControls
|
|
end;
|
|
|
|
procedure TDAEDataset.EnableControls;
|
|
begin
|
|
fDataset.EnableControls
|
|
end;
|
|
|
|
function TDAEDataset.FieldByName(const aName: string): TDAField;
|
|
begin
|
|
result := fFields.FieldByName(aName) as TDAField;
|
|
end;
|
|
|
|
procedure TDAEDataset.FreeBookmark(Bookmark: TBookmark);
|
|
begin
|
|
Dataset.FreeBookmark(Bookmark);
|
|
end;
|
|
|
|
function TDAEDataset.GetBookMark: pointer;
|
|
begin
|
|
result := Dataset.GetBookmark
|
|
end;
|
|
|
|
procedure TDAEDataset.GotoBookmark(Bookmark: TBookmark);
|
|
begin
|
|
Dataset.GotoBookmark(Bookmark);
|
|
end;
|
|
|
|
procedure TDAEDataset.Refresh;
|
|
begin
|
|
|
|
end;
|
|
|
|
function TDAEDataset.GetIsEmpty: boolean;
|
|
begin
|
|
result := fDataset.IsEmpty
|
|
end;
|
|
|
|
function TDAEDataset.GetState: TDatasetState;
|
|
begin
|
|
result := fDataset.State
|
|
end;
|
|
|
|
function TDAEDataset.Lookup(const KeyFields: string;
|
|
const KeyValues: Variant; const ResultFields: string): Variant;
|
|
begin
|
|
result := fDataset.Lookup(KeyFields, KeyValues, ResultFields);
|
|
end;
|
|
|
|
function TDAEDataset.GetLogicalName: string;
|
|
begin
|
|
result := fLogicalName;
|
|
end;
|
|
|
|
function TDAEDataset.FindField(const aName: string): TDAField;
|
|
begin
|
|
result := fFields.FindField(aName) as TDAField;
|
|
end;
|
|
|
|
procedure TDAEDataset.SetLogicalName(aName: string);
|
|
begin
|
|
fLogicalName := aName
|
|
end;
|
|
|
|
function TDAEDataset.GetOnAfterOpen: TDAAfterOpenDatasetEvent;
|
|
begin
|
|
result := fOnAfterOpen
|
|
end;
|
|
|
|
function TDAEDataset.GetOnBeforeOpen: TDABeforeOpenDatasetEvent;
|
|
begin
|
|
result := fOnBeforeOpen
|
|
end;
|
|
|
|
procedure TDAEDataset.SetOnAfterOpen(
|
|
const Value: TDAAfterOpenDatasetEvent);
|
|
begin
|
|
fOnAfterOpen := Value
|
|
end;
|
|
|
|
procedure TDAEDataset.SetOnBeforeOpen(
|
|
const Value: TDABeforeOpenDatasetEvent);
|
|
begin
|
|
fOnBeforeOpen := Value
|
|
end;
|
|
|
|
function TDAEDataset.GetOnOpenError: TDAOpenDatasetErrorEvent;
|
|
begin
|
|
result := fOnOpenError;
|
|
end;
|
|
|
|
procedure TDAEDataset.SetOnOpenError(
|
|
const Value: TDAOpenDatasetErrorEvent);
|
|
begin
|
|
fOnOpenError := Value;
|
|
end;
|
|
|
|
function TDAEDataset.GetCurrentRecIdValue: integer;
|
|
begin
|
|
result := -1;
|
|
end;
|
|
|
|
procedure TDAEDataset.SetCurrentRecIdValue(Value: integer);
|
|
begin
|
|
|
|
end;
|
|
|
|
function TDAEDataset.GetRowRecIdValue: integer;
|
|
begin
|
|
result := -1
|
|
end;
|
|
|
|
procedure TDAEDataset.DisableConstraints;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
procedure TDAEDataset.EnableConstraints;
|
|
begin
|
|
// do nothing
|
|
end;
|
|
|
|
function TDAEDataset.IsNeedCreateFieldDefs: Boolean;
|
|
begin
|
|
Result:=False;
|
|
end;
|
|
|
|
procedure TDAEDataset.CreateFieldDefs;
|
|
var
|
|
i: integer;
|
|
fld: TFieldDef;
|
|
dafld: TDAField;
|
|
begin
|
|
fDataset.FieldDefs.Clear;
|
|
// 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
|
|
|
|
fld := fDataset.FieldDefs.AddFieldDef;
|
|
|
|
// (autoinc)
|
|
if (dafld.DataType=datLargeAutoInc) then fld.DataType := ftLargeint
|
|
else if (dafld.DataType=datAutoInc) then fld.DataType := ftInteger
|
|
else fld.DataType := DATypeToVCLType(dafld.DataType);
|
|
|
|
fld.Name := dafld.Name;
|
|
|
|
{if not (fld.DataType in [ftFloat, ftCurrency, ftBlob, ftInteger])
|
|
then fld.Size := Fields[i].Size;}
|
|
|
|
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;
|
|
end;
|
|
end;
|
|
|
|
// 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;
|
|
var
|
|
i: integer;
|
|
lNeedToFix: Boolean;
|
|
fld: TField;
|
|
begin
|
|
lNeedToFix:= False;
|
|
for i:=0 to fDataset.Fields.Count-1 do
|
|
if (fDataset.Fields[i].DataType = ftFMTBcd) and
|
|
(TFMTBCDField(fDataset.Fields[i]).Precision=15) and
|
|
(TFMTBCDField(fDataset.Fields[i]).Size=4) then begin
|
|
lNeedToFix:=True;
|
|
Break;
|
|
end;
|
|
if not lNeedToFix then Exit;
|
|
for i := 0 to (fDataset.FieldCount - 1) do begin
|
|
fld := fDataset.Fields[i];
|
|
with fFields.Add(fld.FieldName, intVCLTypeToDAType(fld.DataType), fld.Size) do
|
|
if DataType = datDecimal then begin
|
|
DecimalPrecision:= TFMTBCDField(fld).Precision;
|
|
DecimalScale:= TFMTBCDField(fld).Size;
|
|
if (DecimalPrecision =15 ) and (DecimalScale=4) then begin
|
|
DecimalPrecision:=24;
|
|
DecimalScale:=8;
|
|
end;
|
|
end;
|
|
end;
|
|
fDataset.Close;
|
|
CreateFieldDefs;
|
|
fDataset.Open;
|
|
end;
|
|
|
|
{ TDAESQLCommand }
|
|
|
|
constructor TDAESQLCommand.Create(aConnection: TDAEConnection; const aName: string = '');
|
|
var
|
|
id: TGUID;
|
|
begin
|
|
inherited Create;
|
|
|
|
fName := aName;
|
|
if (fName = '') then begin
|
|
CreateGUID(id);
|
|
fName := GUIDToString(id);
|
|
end;
|
|
|
|
fWhere := TDAWhere.Create(nil, FALSE);
|
|
fDynamicWhere:= nil;// aConnection.GetWhereBuilder;
|
|
fConnection := aConnection;
|
|
fParams := TDAParamCollection.Create(nil);
|
|
fDataset := CreateDataset(fConnection);
|
|
end;
|
|
|
|
destructor TDAESQLCommand.Destroy;
|
|
begin
|
|
fDataset.Free;
|
|
fParams.Free;
|
|
fWhere.Free;
|
|
fDynamicWhere.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TDAESQLCommand.GetWhere: TDAWhere;
|
|
begin
|
|
result := fWhere;
|
|
end;
|
|
|
|
function TDAESQLCommand.GetParams: TDAParamCollection;
|
|
begin
|
|
result := fParams;
|
|
end;
|
|
|
|
function TDAESQLCommand.GetProviderSupport: IProviderSupport;
|
|
begin
|
|
result := uDAUtils.GetProviderSupport(fDataset);
|
|
end;
|
|
|
|
function TDAESQLCommand.ParamByName(const aName: string): TDAParam;
|
|
begin
|
|
result := fParams.ParamByName(aName)
|
|
end;
|
|
|
|
procedure TDAESQLCommand.RefreshParams;
|
|
var
|
|
lParams: TParams;
|
|
lSQL: string;
|
|
i: integer;
|
|
par: TDAParam;
|
|
begin
|
|
//dsparams := GetProviderSupport.PSGetParams;
|
|
|
|
lParams := TParams.Create;
|
|
try
|
|
|
|
{ Bug in ParseSQL modified passed in string; use UniqueString to prevent
|
|
corrupting the original! }
|
|
lSQL := fSQL;
|
|
UniqueString(lSQL);
|
|
lParams.ParseSQL(lSQL, TRUE);
|
|
|
|
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
|
|
ps: IProviderSupport;
|
|
dsparams: TParams;
|
|
mspars: IDAMustSetParams;
|
|
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 begin
|
|
|
|
// ADOExpress does not use TParams so we mush use this trick
|
|
if Supports(Self, IDAMustSetParams, mspars) then
|
|
mspars.SetParamValues(fParams)
|
|
|
|
// All the others instead return a reference to the TParams object
|
|
else begin
|
|
ps := GetProviderSupport;
|
|
|
|
dsparams := ps.PSGetParams;
|
|
fParams.WriteValues(dsparams);
|
|
end;
|
|
end;
|
|
|
|
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;
|
|
if Supports(Self, IDAMustSetParams, mspars) then
|
|
mspars.GetParamValues(fParams)
|
|
|
|
else begin
|
|
ps := GetProviderSupport;
|
|
|
|
dsparams := ps.PSGetParams;
|
|
fParams.ReadValues(dsparams);
|
|
end;
|
|
|
|
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;
|
|
|
|
if fDynamicWhere <> nil then
|
|
For i:=0 to fDynamicWhere.Params.Count-1 do
|
|
Self.GetParams.Add.AssignField(fDynamicWhere.Params[i]);
|
|
|
|
sql := fConnection.fMacroProcessor.Eval(sql);
|
|
end;
|
|
|
|
DoSetSQL(sql);
|
|
DoPrepare(fPrepared);
|
|
|
|
Changed := false;
|
|
end;
|
|
end;
|
|
|
|
function TDAESQLCommand.DoExecute: integer;
|
|
begin
|
|
// Default implementation that should work for every dataset
|
|
result := 0;
|
|
GetProviderSupport.PSExecute;
|
|
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;
|
|
PrepareSQLStatement();
|
|
end;
|
|
end;
|
|
|
|
function TDAESQLCommand.GetDataset: TDataset;
|
|
begin
|
|
result := fDataset;
|
|
end;
|
|
|
|
function TDAESQLCommand.GetName: string;
|
|
begin
|
|
result := fName;
|
|
end;
|
|
|
|
procedure TDAESQLCommand.DoPrepare(Value: boolean);
|
|
begin
|
|
SetPropValue(fDataset, 'Prepared', Value); // Works with ADO and IBX for now
|
|
end;
|
|
|
|
function TDAESQLCommand.GetOnAfterExecute: TDAAfterExecuteCommandEvent;
|
|
begin
|
|
result := fOnAfterExecute
|
|
end;
|
|
|
|
function TDAESQLCommand.GetOnBeforeExecute: TDABeforeExecuteCommandEvent;
|
|
begin
|
|
result := fOnBeforeExecute
|
|
end;
|
|
|
|
procedure TDAESQLCommand.SetOnAfterExecute(
|
|
const Value: TDAAfterExecuteCommandEvent);
|
|
begin
|
|
fOnAfterExecute := Value
|
|
end;
|
|
|
|
procedure TDAESQLCommand.SetOnBeforeExecute(
|
|
const Value: TDABeforeExecuteCommandEvent);
|
|
begin
|
|
fOnBeforeExecute := Value
|
|
end;
|
|
|
|
function TDAESQLCommand.GetOnExecuteError: TDAExecuteCommandErrorEvent;
|
|
begin
|
|
result := fOnExecuteError;
|
|
end;
|
|
|
|
procedure TDAESQLCommand.SetOnExecuteError(
|
|
const Value: TDAExecuteCommandErrorEvent);
|
|
begin
|
|
fOnExecuteError := Value;
|
|
end;
|
|
|
|
function TDAESQLCommand.intVCLTypeToDAType(
|
|
aFieldType: TFieldType): TDADataType;
|
|
begin
|
|
Result := VCLTypeToDAType(aFieldType);
|
|
end;
|
|
|
|
function TDAESQLCommand.GetDynamicWhere: TDAWhereBuilder;
|
|
begin
|
|
if fDynamicWhere = nil then fDynamicWhere := Connection.GetWhereBuilder;
|
|
Result:=fDynamicWhere;
|
|
end;
|
|
|
|
procedure TDAESQLCommand.SetDynamicWhere(const Value: TDAWhereBuilder);
|
|
begin
|
|
if Value <> nil then
|
|
GetDynamicWhere.Xml := Value.Xml
|
|
else if fDynamicWhere <> nil then
|
|
FDynamicWhere.Clear;
|
|
end;
|
|
|
|
function TDAESQLCommand.GenerateDynamicWhereStatement: string;
|
|
begin
|
|
if (fDynamicWhere <> nil) and not fDynamicWhere.IsEmpty then Result := fDynamicWhere.CreateWhereClause;
|
|
if Result = '' then Result:= ' (1=1)';
|
|
end;
|
|
|
|
function TDAESQLCommand.SQLContainsDynamicWhere: boolean;
|
|
var
|
|
mac: IDAHasMacroProcessor;
|
|
lmp: TDASQLMacroProcessor;
|
|
begin
|
|
FIsPresentDynWhereVariable:=False;
|
|
if Supports(fConnection, IDAHasMacroProcessor, mac) and (mac.GetMacroProcessor <> nil) then begin
|
|
lmp:=TDASQLMacroProcessor(mac.GetMacroProcessor.NewInstance).Create;
|
|
With lmp do try
|
|
OnUnknownIdentifier := UnknownIdentifier;
|
|
Eval(GetSQL);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
Result:= FIsPresentDynWhereVariable;
|
|
end;
|
|
|
|
function TDAESQLCommand.UnknownIdentifier(Sender: TObject; const Name,
|
|
OrgName: string; var Value: string): Boolean;
|
|
begin
|
|
if SameText(OrgName,'WHERE') then
|
|
FIsPresentDynWhereVariable:=True;
|
|
Value := OrgName;
|
|
Result := True;
|
|
end;
|
|
|
|
{ TDAEStoredProcedure }
|
|
|
|
procedure TDAEStoredProcedure.DoPrepare(Value: boolean);
|
|
begin
|
|
// Stored procs don't need to be prepared
|
|
end;
|
|
|
|
procedure TDAEStoredProcedure.PrepareSQLStatement;
|
|
begin
|
|
// Stored procs don't need to be prepared
|
|
end;
|
|
|
|
procedure TDAEStoredProcedure.RefreshParams;
|
|
var
|
|
lParams: TParams;
|
|
i: integer;
|
|
par: TDAParam;
|
|
begin
|
|
lParams := GetProviderSupport.PSGetParams;
|
|
|
|
fParams.Clear;
|
|
for i := 0 to (lParams.Count - 1) do begin
|
|
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;
|
|
end;
|
|
|
|
{ TDASQLMacroProcessor }
|
|
|
|
constructor TDASQLMacroProcessor.Create(const aDateFormat, aDateTimeFormat: string;
|
|
aDoubleQuoteStrings: boolean;
|
|
const aStoredProcParamsPrefix: string = '');
|
|
begin
|
|
Create;
|
|
fDateFormat := aDateFormat;
|
|
fDateTimeFormat := aDateTimeFormat;
|
|
fDoubleQuoteStrings := aDoubleQuoteStrings;
|
|
fStoredProcParamPrefix := aStoredProcParamsPrefix;
|
|
RegisterMacros;
|
|
end;
|
|
|
|
function TDASQLMacroProcessor.FormatDate(Sender: TObject;
|
|
const Parameters: array of string): string;
|
|
var
|
|
dte: TDateTime;
|
|
begin
|
|
dte := StrToDate(StringReplace(Parameters[0], '''', '', [rfReplaceAll]));
|
|
|
|
if fDoubleQuoteStrings then
|
|
result := '"' + SysUtils.FormatDateTime(fDateFormat, dte) + '"'
|
|
else
|
|
result := '''' + SysUtils.FormatDateTime(fDateFormat, dte) + '''';
|
|
end;
|
|
|
|
function TDASQLMacroProcessor.FormatDateTime(Sender: TObject;
|
|
const Parameters: array of string): string;
|
|
var
|
|
dte: TDateTime;
|
|
begin
|
|
dte := StrToDateTime(StringReplace(Parameters[0], '''', '', [rfReplaceAll]));
|
|
|
|
if fDoubleQuoteStrings then
|
|
result := '"' + SysUtils.FormatDateTime(fDateTimeFormat, dte) + '"'
|
|
else
|
|
result := '''' + SysUtils.FormatDateTime(fDateTimeFormat, dte) + '''';
|
|
end;
|
|
|
|
procedure TDASQLMacroProcessor.RegisterMacros;
|
|
begin
|
|
RegisterProc('Date', Date, 0);
|
|
RegisterProc('DateTime', DateTime, 0);
|
|
RegisterProc('AddTime', AddTime, 3);
|
|
RegisterProc('FormatDateTime', FormatDateTime, 1);
|
|
RegisterProc('FormatDate', FormatDate, 1);
|
|
RegisterProc('Length', Length, 1);
|
|
RegisterProc('LowerCase', LowerCase, 1);
|
|
RegisterProc('UpperCase', UpperCase, 1);
|
|
RegisterProc('TrimLeft', TrimLeft, 1);
|
|
RegisterProc('TrimRight', TrimRight, 1);
|
|
RegisterProc('Copy', Copy, 3);
|
|
RegisterProc('NoLockHint', NoLock, 0);
|
|
end;
|
|
|
|
constructor TDASQLMacroProcessor.Create;
|
|
begin
|
|
inherited Create;
|
|
OnUnknownIdentifier := MyUnknownIdentifier;
|
|
end;
|
|
|
|
function TDASQLMacroProcessor.Date(Sender: TObject;
|
|
const Parameters: array of string): string;
|
|
begin
|
|
result := Self.DateTime(Sender, Parameters);
|
|
end;
|
|
|
|
function TDASQLMacroProcessor.MyUnknownIdentifier(Sender: TObject;
|
|
const Name, OrgName: string; var Value: string): Boolean;
|
|
begin
|
|
Value := OrgName;
|
|
Result := True;
|
|
end;
|
|
|
|
{ TDAConnectionWrapper }
|
|
|
|
procedure TDAConnectionWrapper.DoConnect;
|
|
begin
|
|
SetConnected(TRUE);
|
|
end;
|
|
|
|
procedure TDAConnectionWrapper.DoDisconnect;
|
|
begin
|
|
SetConnected(FALSE);
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
|
|
{ TDAEngineBaseObject }
|
|
|
|
function TDAEngineBaseObject.InterfaceSupportsErrorInfo(const iid: TGUID): HRESULT;
|
|
begin
|
|
if GetInterfaceEntry(iid) <> nil then
|
|
Result := S_OK
|
|
else
|
|
Result := S_FALSE;
|
|
end;
|
|
|
|
procedure TDAEngineBaseObject.OnException(const ServerClass, ExceptionClass, ErrorMessage: WideString;
|
|
ExceptAddr: Integer; const ErrorIID, ProgID: WideString;
|
|
var Handled: Integer; var Result: HRESULT);
|
|
begin
|
|
|
|
end;
|
|
|
|
const
|
|
DA_ERROR_ID : TGUID = '{E479A438-2640-41D2-9DC6-1560C1D08B79}';
|
|
|
|
function StringToWidestring(const aString: string): WideString;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
SetLength(Result, Length(aString));
|
|
for i := 1 to Length(aString)-1 do
|
|
Result[i] := WideChar(aString[I]);
|
|
end;
|
|
|
|
function DAHandleSafeCallException(aObject:TObject; ExceptObject: TObject; ExceptAddr: Pointer): HResult;
|
|
var
|
|
lClassName: string;
|
|
E: TObject;
|
|
CreateError: ICreateErrorInfo;
|
|
ErrorInfo: IErrorInfo;
|
|
begin
|
|
Result := E_UNEXPECTED;
|
|
E := ExceptObject;
|
|
if Succeeded(CreateErrorInfo(CreateError)) then begin
|
|
CreateError.SetGUID(DA_ERROR_ID);
|
|
lClassName := aObject.ClassName;
|
|
if MainInstance <> HInstance then
|
|
lClassname := Format('%s in %s',[lClassName,ExtractFileName({$IFDEF FPC}ParamStr(0){$ELSE}GetModuleName(hInstance){$ENDIF})]);
|
|
CreateError.SetSource(PWideChar(StringToWidestring(E.ClassName+': '+lClassName)));
|
|
if E is Exception then begin
|
|
CreateError.SetDescription(PWideChar(WideString(Exception(E).Message)));
|
|
CreateError.SetHelpContext(Exception(E).HelpContext);
|
|
if (E is EOleSysError) and (EOleSysError(E).ErrorCode < 0) then
|
|
Result := EOleSysError(E).ErrorCode;
|
|
end;
|
|
if CreateError.QueryInterface(IErrorInfo, ErrorInfo) = S_OK then
|
|
SetErrorInfo(0, ErrorInfo);
|
|
end;
|
|
end;
|
|
|
|
function TDAEngineBaseObject.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult;
|
|
begin
|
|
Result := DAHandleSafeCallException(self, ExceptObject, ExceptAddr);
|
|
end;
|
|
|
|
procedure DASafeCallError(ErrorCode: Integer; ErrorAddr: Pointer);
|
|
var
|
|
lExceptionClass: ExceptClass;
|
|
p: Integer;
|
|
lSource: WideString;
|
|
ErrorInfo: IErrorInfo;
|
|
lDescription: WideString;
|
|
lGuid: TGUID;
|
|
begin
|
|
if GetErrorInfo(0, ErrorInfo) = S_OK then begin
|
|
ErrorInfo.GetDescription(lDescription);
|
|
ErrorInfo.GetGUID(lGuid);
|
|
if IsEqualGUID(lGuid,DA_ERROR_ID) then begin
|
|
ErrorInfo.GetSource(lSource);
|
|
p := Pos(':', lSource);
|
|
if p > 0 then begin
|
|
lExceptionClass := GetExceptionClass(copy(lSource,1,p-1));
|
|
if Assigned(lExceptionClass) then
|
|
raise lExceptionClass.Create(lDescription);
|
|
end;
|
|
end;
|
|
raise Exception.Create(lDescription) at ErrorAddr;
|
|
end
|
|
else begin
|
|
raise Exception.Create('A "safecall" error occured, but the source object did not provide the proper error information. Sorry we cannot be more helpful at this time.') at ErrorAddr;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
SafeCallErrorProc := @DASafeCallError;
|
|
RegisterExceptionClass(EAbort);
|
|
finalization
|
|
UnregisterExceptionClass(EAbort);
|
|
SafeCallErrorProc := nil;
|
|
{$ENDIF}
|
|
end.
|