2710 lines
100 KiB
ObjectPascal
2710 lines
100 KiB
ObjectPascal
{-------------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Driver Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up }
|
|
{ platform: Win32 }
|
|
{ }
|
|
{ (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. }
|
|
{ }
|
|
{ Based on AnyDAC Driver by Dmitry Arefiev (www.da-soft.com) }
|
|
{-------------------------------------------------------------------------------}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
{$I ..\DataAbstract.inc}
|
|
{$ENDIF MSWINDOWS}
|
|
{$IFDEF LINUX}
|
|
{$I ../DataAbstract.inc}
|
|
{$ENDIF LINUX}
|
|
|
|
{$I uAD.inc}
|
|
{$IFNDEF DataAbstract_SchemaModelerOnly}
|
|
{$DEFINE ANYDAC_DEBUGMODE}
|
|
{$ENDIF}
|
|
|
|
unit uDAAnyDACDriver;
|
|
|
|
interface
|
|
|
|
uses
|
|
DB, Classes,
|
|
uROClasses,
|
|
uDAEngine, uDAInterfaces, uDAInterfacesEx, uDAUtils, uDAOracleInterfaces,
|
|
uDAMySQLInterfaces, uDAADOInterfaces, uDAIBInterfaces, uDADB2Interfaces,
|
|
uDASybaseInterfaces,
|
|
uADStanIntf, uADStanOption, uADDatSManager, uADPhysIntf, uADCompClient
|
|
{$IFDEF AnyDAC_MONITOR}
|
|
,uADMoniBase, uADMoniCustom
|
|
{$ENDIF}
|
|
;
|
|
|
|
type
|
|
TDAAnyDACDriverType = TADRDBMSKind;
|
|
|
|
{ TDAAnyDACDriver }
|
|
TDAAnyDACDriver = class(TDADriverReference)
|
|
end;
|
|
|
|
{ TDAEAnyDACDriver }
|
|
TDAEAnyDACDriver = class(TDAEDriver, IDADriver40)
|
|
private
|
|
FConnectionDefs: TStringList;
|
|
FConnectionDefIndex: Integer;
|
|
{$IFDEF AnyDAC_MONITOR}
|
|
FMonitor: TADMoniCustomClientLink;
|
|
FTraceCallback: TDALogTraceEvent;
|
|
procedure DoTrace(ASender: TADMoniClientLinkBase; const AClassName, AObjName, AMessage: String);
|
|
{$ENDIF AnyDAC_MONITOR}
|
|
function LookupConnectionString(const AConnectionString: String; AParsedParams: TStringList): String;
|
|
protected
|
|
{$IFDEF AnyDAC_MONITOR}
|
|
procedure DoSetTraceOptions(TraceActive: Boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent); override;
|
|
{$ENDIF AnyDAC_MONITOR}
|
|
function GetConnectionClass: TDAEConnectionClass; override;
|
|
// IDADriver
|
|
procedure Initialize; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure Finalize; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetDriverID: string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetDescription: string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetAuxDrivers(out List: IROStrings); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetAvailableDriverOptions: TDAAvailableDriverOptions; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetDefaultConnectionType(const AuxDriver: string): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
// IDADriver40
|
|
function GetProviderDefaultCustomParameters(Provider: string): string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
end;
|
|
|
|
{ TDAEAnyDACConnection }
|
|
TDAEAnyDACConnection = class(TDAEConnection, IDAConnection,
|
|
IDAADOConnection,
|
|
IDAInterbaseConnection,
|
|
IDAIBTransactionAccess,
|
|
IDAIBConnectionProperties,
|
|
IDAOracleConnection,
|
|
IDAMySQLConnection,
|
|
IDADB2Connection,
|
|
IDASybaseConnection,
|
|
IDAConnectionModelling,
|
|
IDACanQueryDatabaseNames,
|
|
IDAFileBasedDatabase,
|
|
IDAUseGenerators,
|
|
IDACanQueryGeneratorsNames,
|
|
IDATestableObject)
|
|
private
|
|
FADConnection: TADConnection;
|
|
fDriverType: TDAAnyDACDriverType;
|
|
fMSSQLSchemaEnabled: Boolean;
|
|
fBiDirectionalDataSets: Boolean;
|
|
fDirectMode: Boolean;
|
|
FDataTypeSchema: String;
|
|
procedure DoGetNames(AList: IROStrings; AObjectType: TDAObjecttype);
|
|
procedure Native_DoGetTableFields(aTableName: string; out Fields: TDAFieldCollection);
|
|
procedure Native_DoGetForeignKeys(ForeignKeys: TDADriverForeignKeyCollection);
|
|
function Native_DoGetLastAutoInc(const GeneratorName: string): integer;
|
|
function Native_GetQuoteChars: TDAQuoteCharArray;
|
|
function GetAnyDACPhysConnection:IADPhysConnection;
|
|
procedure MapAsFIB;
|
|
protected
|
|
// IInterface
|
|
function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
|
|
// TDAEConnection
|
|
function CreateCustomConnection: TCustomConnection; override;
|
|
function CreateMacroProcessor: TDASQLMacroProcessor; override;
|
|
function GetDatasetClass: TDAEDatasetClass; override;
|
|
function GetStoredProcedureClass: TDAEStoredProcedureClass; override;
|
|
procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection); override;
|
|
procedure SetupDataset(ADataSet: TADRdbmsDataSet; AFetchMeta: Boolean);
|
|
procedure SetupOptions(AOptions: IADStanOptions; AFetchMeta: Boolean);
|
|
function DoBeginTransaction: integer; override;
|
|
procedure DoCommitTransaction; override;
|
|
procedure DoRollbackTransaction; override;
|
|
function DoGetInTransaction: boolean; override;
|
|
procedure DoGetTableNames(out List: IROStrings); override;
|
|
procedure DoGetViewNames(out List: IROStrings); override;
|
|
procedure DoGetStoredProcedureNames(out List: IROStrings); override;
|
|
procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); override;
|
|
procedure DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection); override;
|
|
procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); override;
|
|
function DoGetLastAutoInc(const GeneratorName: string): integer; override;
|
|
// IDATestObject
|
|
// nothing
|
|
// IDAConnection
|
|
function GetSPSelectSyntax(AHasArguments: Boolean): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetQuoteChars: TDAQuoteCharArray; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function IdentifierNeedsQuoting(const AIdentifier: string): boolean; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
// IDAADOConnection
|
|
function GetProviderName: string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetProviderType: TDAOleDBProviderType; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetCommandTimeout: Integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure SetCommandTimeout(const Value: Integer); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
// IDAInterbaseConnection
|
|
// nothing
|
|
// IDAIBTransactionAccess
|
|
function GetTransaction: TObject; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
// IDAIBConnectionProperties
|
|
function GetRole: string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure SetRole(const Value: string); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetSQLDialect: integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure SetSQLDialect(Value: integer); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetCharset: string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure SetCharset(const Value: string); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure Commit; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure CommitRetaining; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure Rollback; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure RollbackRetaining; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
// IDAOracleConnection
|
|
// nothing
|
|
// IDAConnectionModelling
|
|
function FieldToDeclaration(aField: TDAField): string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function BuildCreateTableSQL(aDataSet: TDADataSet; const aOverrideName: string = ''): string; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure CreateTable(aDataSet: TDADataSet; const aOverrideName: string = ''); {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
// IDACanQueryDatabaseNames
|
|
function GetDatabaseNames: IROStrings;
|
|
// IDAFileBasedDatabase
|
|
function GetFileExtensions: IROStrings;
|
|
// IDADirectoryBasedDatabase
|
|
// nothing
|
|
// IDAUseGenerators
|
|
function GetNextAutoinc(const GeneratorName: string): integer; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
// IDACanQueryGeneratorsNames
|
|
function GetGeneratorNames: IROStrings;
|
|
end;
|
|
|
|
{ TDAEAnyDACQuery }
|
|
TDAEAnyDACQuery = class(TDAEDataset, IDAMustSetParams)
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
// TDAEDataset
|
|
procedure DoPrepare(AValue: boolean); override;
|
|
function DoExecute: integer; override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function DoGetSQL: string; override;
|
|
procedure DoSetSQL(const AValue: string); override;
|
|
procedure ClearParams; override;
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(AParams: TDAParamCollection); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
end;
|
|
|
|
{ TDAEAnyDACStoredProcedure }
|
|
TDAEAnyDACStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
// TDAEDataset
|
|
procedure RefreshParams; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetStoredProcedureName: string; override;
|
|
procedure SetStoredProcedureName(const Name: string); override;
|
|
function DoExecute: integer; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function Execute: integer; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(AParams: TDAParamCollection); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
end;
|
|
|
|
{ TDAEAnyDACNativeField }
|
|
TDAEAnyDACNativeField = class(TInterfacedObject, IDANativeField)
|
|
private
|
|
FCol: TADDatSColumn;
|
|
FCmd: IADPhysCommand;
|
|
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(ACol: TADDatSColumn; const ACmd: IADPhysCommand);
|
|
end;
|
|
|
|
{ TDAEAnyDACNativeDatabaseAccess }
|
|
TDAEAnyDACNativeDatabaseAccessFlags = set of (nfActive, nfBOF, nfEOF);
|
|
TDAEAnyDACNativeDatabaseAccess = class(TObject, IInterface, IDANativeDatabaseAccess)
|
|
private
|
|
FCmd: IADPhysCommand;
|
|
FTab: TADDatSTable;
|
|
FFlags: TDAEAnyDACNativeDatabaseAccessFlags;
|
|
FRowIndex: Integer;
|
|
FRowsPurged: Integer;
|
|
FBuffs: array of Pointer;
|
|
procedure First;
|
|
procedure CheckActive;
|
|
procedure CheckBidir;
|
|
function LocateRecord(const KeyFields: string; const KeyValues: Variant;
|
|
Options: TLocateOptions; AChangePos: Boolean): Integer;
|
|
protected
|
|
// IInterface
|
|
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
|
|
function _AddRef: Integer; stdcall;
|
|
function _Release: Integer; stdcall;
|
|
// IDANativeDatabaseAccess
|
|
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 GetNativeFieldValue(Index: Integer): Variant;
|
|
function CanFreeNativeFieldData: Boolean;
|
|
public
|
|
Constructor Create(ADAEConnection: TDAEAnyDACConnection);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TDAEAnyDACQueryNative }
|
|
TDAEAnyDACQueryNative = class(TDAEDataset, IDAMustSetParams)
|
|
private
|
|
function GetNativeObject: TDAEAnyDACNativeDatabaseAccess;
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
function CreateNativeObject(aConnection: TDAEConnection): TObject; override;
|
|
function CreateNativeDatabaseAccess: IDANativeDatabaseAccess; override;
|
|
// TDAEDataset
|
|
procedure DoPrepare(AValue: boolean); override;
|
|
function DoExecute: integer; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function DoGetSQL: string; override;
|
|
procedure DoSetSQL(const AValue: string); override;
|
|
procedure ClearParams; override;
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(AParams: TDAParamCollection); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
public
|
|
property NativeObject: TDAEAnyDACNativeDatabaseAccess read GetNativeObject;
|
|
end;
|
|
|
|
{ TDAEAnyDACStoredProcedureNative }
|
|
TDAEAnyDACStoredProcedureNative = class(TDAEStoredProcedure, IDAMustSetParams)
|
|
private
|
|
function GetNativeObject: TDAEAnyDACNativeDatabaseAccess;
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
function CreateNativeObject(aConnection: TDAEConnection): TObject; override;
|
|
function CreateNativeDatabaseAccess: IDANativeDatabaseAccess; override;
|
|
// TDAEDataset
|
|
procedure RefreshParams; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetStoredProcedureName: string; override;
|
|
procedure SetStoredProcedureName(const Name: string); override;
|
|
function DoExecute: integer; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function Execute: integer; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(AParams: TDAParamCollection); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
public
|
|
property NativeObject: TDAEAnyDACNativeDatabaseAccess read GetNativeObject;
|
|
end;
|
|
|
|
procedure Register;
|
|
function GetDriverObject: IDADriver; stdcall;
|
|
function AnyDACDriverIdToAnyDACDriverType(Provider: string): TDAAnyDACDriverType;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF FPC} LResources, {$ENDIF}
|
|
{$IFDEF MSWINDOWS} Windows, {$ENDIF}
|
|
SysUtils, Variants, FmtBCD,
|
|
uDADriverManager, uDARes, uDAHelpers, uROBinaryHelpers,
|
|
uADStanParam, uADStanConst, uADStanFactory, uADGUIxConsoleWait, uADPhysManager,
|
|
uADPhysODBC, uADPhysOracl, uADPhysMySQL, uADPhysMSSQL, uADPhysMSAcc, uADPhysDB2,
|
|
uADPhysASA, uADPhysIB, uADPhysADS, uADStanUtil
|
|
{$IFDEF AnyDAC_D11}
|
|
, uADPhysTDBX
|
|
{$ELSE}
|
|
{$IFDEF AnyDAC_D6}
|
|
, uADPhysDbExp
|
|
{$ENDIF}
|
|
{$ENDIF};
|
|
|
|
{$IFNDEF FPC}
|
|
{$R DataAbstract_AnyDACDriver_Glyphs.res}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DataAbstract_SchemaModelerOnly}
|
|
{$INCLUDE ..\DataAbstract_SchemaModelerOnly.inc}
|
|
{$ENDIF DataAbstract_SchemaModelerOnly}
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ Generic procedures }
|
|
{------------------------------------------------------------------------------}
|
|
function AnyDACDriverIdToAnyDACDriverType(Provider: string): TDAAnyDACDriverType;
|
|
var
|
|
FConnectionIntf: IADPhysConnection;
|
|
oConMeta: IADPhysConnectionMetadata;
|
|
begin
|
|
Result := mkUnknown;
|
|
if Provider = '' then
|
|
Exit;
|
|
try
|
|
with TADConnection.Create(nil) do
|
|
try
|
|
ResultConnectionDef.DriverID := Provider;
|
|
ADPhysManager.CreateConnection(ResultConnectionDef, FConnectionIntf);
|
|
if FConnectionIntf <> nil then begin
|
|
FConnectionIntf.CreateMetadata(oConMeta);
|
|
Result := oConMeta.Kind;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
except
|
|
// hide an exception
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure SetADParamValuesFromDA(ADAParams: TDAParamCollection;
|
|
AADParams: TADParams; ASetType: Boolean);
|
|
var
|
|
i: integer;
|
|
oDAPar: TDAParam;
|
|
oADPar: TADParam;
|
|
begin
|
|
for i := 0 to AADParams.Count - 1 do begin
|
|
oADPar := AADParams[i];
|
|
oDAPar := ADAParams.ParamByName(oADPar.Name);
|
|
oADPar.ParamType := TParamType(oDAPar.ParamType);
|
|
if oDAPar.ParamType in [daptInput, daptInputOutput, daptUnknown] then
|
|
if oDAPar.DataType in [datBlob, datMemo, datWideMemo] then begin
|
|
if ASetType then
|
|
if oDAPar.BlobType = dabtUnknown then
|
|
case oDAPar.DataType of
|
|
datMemo: oADPar.DataType := ftMemo;
|
|
datBlob: oADPar.DataType := ftBlob;
|
|
datWideMemo: oADPar.DataType := {$IFDEF AnyDAC_D10} ftWideMemo {$ELSE} ftFmtMemo {$ENDIF};
|
|
end
|
|
else
|
|
oADPar.DataType := BlobTypeMappings[oDAPar.BlobType];
|
|
if VarIsEmpty(oDAPar.Value) or VarIsNull(oDAPar.Value) then
|
|
oADPar.Clear
|
|
else
|
|
oADPar.AsBlob := VariantBinaryToString(oDAPar.Value);
|
|
end
|
|
else begin
|
|
if ASetType then
|
|
oADPar.DataType := DATypeToVCLType(oDAPar.DataType);
|
|
if VarIsEmpty(oDAPar.Value) or VarIsNull(oDAPar.Value) then
|
|
oADPar.Clear
|
|
else
|
|
oADPar.Value := oDAPar.Value;
|
|
end
|
|
else
|
|
if ASetType then begin
|
|
oADPar.DataType := DATypeToVCLType(oDAPar.DataType);
|
|
oADPar.Size := oDAPar.Size;
|
|
oADPar.Precision := oDAPar.DecimalPrecision;
|
|
oADPar.NumericScale := oDAPar.DecimalScale;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure GetDAParamValuesFromAD(Params: TDAParamCollection; AADParams: TADParams);
|
|
var
|
|
i: integer;
|
|
oDAPar: TDAParam;
|
|
oADPar: TADParam;
|
|
begin
|
|
if not Assigned(AADParams) then
|
|
Exit;
|
|
for i := 0 to AADParams.Count - 1 do begin
|
|
oADPar := AADParams[i];
|
|
oDAPar := Params.ParamByName(oADPar.Name);
|
|
if oDAPar.ParamType in [daptOutput, daptInputOutput, daptResult] then
|
|
oDAPar.Value := oADPar.Value;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function MapAD2DADataType(AADDataType: TADDataType; out ABlobType: TDABlobType): TDADataType;
|
|
begin
|
|
ABlobType := dabtUnknown;
|
|
case AADDataType of
|
|
dtUnknown: Result := datUnknown;
|
|
dtBoolean: Result := datBoolean;
|
|
dtSByte: Result := datShortInt;
|
|
dtInt16: Result := datSmallInt;
|
|
dtInt32: Result := datInteger;
|
|
dtInt64: Result := datLargeInt;
|
|
dtByte: Result := datByte;
|
|
dtUInt16: Result := datWord;
|
|
dtUInt32: Result := datCardinal;
|
|
dtUInt64: Result := datLargeUInt;
|
|
dtDouble: Result := datFloat;
|
|
dtCurrency: Result := datFloat; // Double
|
|
dtBCD: Result := datCurrency; // Currency
|
|
dtFmtBCD: Result := datDecimal; // TBcd
|
|
dtDateTime: Result := datDateTime;
|
|
dtTime: Result := datDateTime;
|
|
dtDate: Result := datDateTime;
|
|
dtDateTimeStamp: Result := datDateTime;
|
|
dtAnsiString: Result := datString;
|
|
dtWideString: Result := datWideString;
|
|
dtByteString: Result := datString;
|
|
dtBlob: begin Result := datBlob; ABlobType := dabtBlob; end;
|
|
dtMemo: begin Result := datMemo; ABlobType := dabtMemo; end;
|
|
dtWideMemo: begin Result := datWideMemo; ABlobType := dabtMemo; end;
|
|
dtHBlob: begin Result := datBlob; ABlobType := dabtOraBlob; end;
|
|
dtHMemo: begin Result := datMemo; ABlobType := dabtOraClob; end;
|
|
dtWideHMemo: begin Result := datWideMemo; ABlobType := dabtOraClob; end;
|
|
dtHBFile: begin Result := datBlob; ABlobType := dabtOraBlob; end;
|
|
dtGUID: Result := datGuid;
|
|
else raise Exception.CreateFmt('AnyDAC data type [%s] is not supported by DataAbstract',
|
|
[C_AD_DataTypeNames[AADDataType]]);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TDAEAnyDACDriver }
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACDriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
|
|
begin
|
|
result := [doAuxDriver, doServerName, doDatabaseName, doLogin, doCustom];
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACDriver.GetConnectionClass: TDAEConnectionClass;
|
|
begin
|
|
result := TDAEAnyDACConnection;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACDriver.GetDescription: string;
|
|
begin
|
|
result := 'RemObjects AnyDAC Driver'{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF};
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACDriver.GetDriverID: string;
|
|
begin
|
|
result := 'AnyDAC';
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACDriver.GetAuxDrivers(out List: IROStrings);
|
|
begin
|
|
List := NewROStrings;
|
|
ADManager.GetDriverNames(List.Strings);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACDriver.GetProviderDefaultCustomParameters(Provider: string): string;
|
|
begin
|
|
Result := '';
|
|
case AnyDACDriverIdToAnyDACDriverType(Provider) of
|
|
mkOracle: Result := S_AD_ConnParam_Common_OSAuthent + '=No;';
|
|
mkMSSQL: Result := 'Schemas=1;Integrated Security=SSPI;';
|
|
mkMySQL: Result := MYSQL_GetDefaultCustomParameters;
|
|
mkInterbase: Result := S_AD_ConnParam_IB_Protocol + '=TCPIP;';
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACDriver.GetDefaultConnectionType(const AuxDriver: string): string;
|
|
begin
|
|
case AnyDACDriverIdToAnyDACDriverType(AuxDriver) of
|
|
mkOracle: Result := Oracle_DriverType;
|
|
mkMSSQL: Result := MSSQL_DriverType;
|
|
mkMSAccess: Result := Access_DriverType;
|
|
mkMySQL: Result := MySQL_DriverType;
|
|
mkDB2: Result := DB2_DriverType;
|
|
mkASA: Result := ASA_DriverType;
|
|
mkInterbase: Result := IB_DriverType;
|
|
else
|
|
Result := inherited GetDefaultConnectionType(AuxDriver);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACDriver.GetAuxParams(const AuxDriver: string;
|
|
out List: IROStrings);
|
|
const
|
|
C_Line: String = '-----------------------------';
|
|
begin
|
|
inherited;
|
|
|
|
List.Add('AnyDAC Driver parameters');
|
|
List.Add(C_Line);
|
|
case AnyDACDriverIdToAnyDACDriverType(AuxDriver) of
|
|
mkOracle:
|
|
;
|
|
mkMSSQL:
|
|
MSSQL_GetAuxParams(List);
|
|
mkMSAccess:
|
|
;
|
|
mkMySQL:
|
|
MYSQL_GetAuxParams(List);
|
|
mkDB2:
|
|
;
|
|
mkASA:
|
|
;
|
|
mkInterbase:
|
|
begin
|
|
AddIBAuxParams(List);
|
|
List.Add('DataTypeSchema=<FIB>');
|
|
end;
|
|
end;
|
|
List.Add('ConnectionDefName=<string>');
|
|
List.Add('BiDirectionalDataSets=0,1');
|
|
List.Add('DirectMode=0,1');
|
|
List.Add('');
|
|
|
|
case AnyDACDriverIdToAnyDACDriverType(AuxDriver) of
|
|
mkOracle:
|
|
begin
|
|
List.Add('Oracle AuxDriver parameters');
|
|
List.Add(C_Line);
|
|
List.Add('You can pass any parameters directly to aux driver. Use the prefix ''@'' for this, e.g.:');
|
|
List.Add('@SQLTrace=True;@Pooled=True');
|
|
List.Add('');
|
|
List.Add('Detailed description of aux driver parameters you can find at:');
|
|
List.Add('http://wiki.remobjects.com/wiki/Connect_to_Oracle_Server_%28AnyDAC%29');
|
|
end;
|
|
mkMSSQL:
|
|
begin
|
|
List.Add('MSSQL AuxDriver parameters');
|
|
List.Add(C_Line);
|
|
List.Add('');
|
|
List.Add('You can pass any parameters directly to aux driver. Use the prefix ''@'' for this, e.g.:');
|
|
List.Add('@App=My DA Server;@Pooled=True');
|
|
List.Add('');
|
|
List.Add('Detailed description of aux driver parameters you can find at:');
|
|
List.Add('http://wiki.remobjects.com/wiki/Connect_to_Microsoft_SQL_Server_%28AnyDAC%29');
|
|
end;
|
|
mkMSAccess:
|
|
begin
|
|
List.Add('MSAccess AuxDriver parameters');
|
|
List.Add(C_Line);
|
|
List.Add('You can pass any parameters directly to aux driver. Use the prefix ''@'' for this, e.g.:');
|
|
List.Add('@ReadOnly=True;@Pooled=True');
|
|
List.Add('');
|
|
List.Add('Detailed description of aux driver parameters you can find at:');
|
|
List.Add('http://wiki.remobjects.com/wiki/Connect_to_MS_Access_database_%28AnyDAC%29');
|
|
end;
|
|
mkMySQL:
|
|
begin
|
|
List.Add('MySQL AuxDriver parameters');
|
|
List.Add(C_Line);
|
|
List.Add('You can pass any parameters directly to aux driver. Use the prefix ''@'' for this, e.g.:');
|
|
List.Add('@CharacterSet=utf8;@Pooled=True');
|
|
List.Add('');
|
|
List.Add('Detailed description of aux driver parameters you can find at:');
|
|
List.Add('http://wiki.remobjects.com/wiki/Connect_to_MySQL_Server_%28AnyDAC%29');
|
|
end;
|
|
mkDB2:
|
|
begin
|
|
List.Add('DB2 AuxDriver parameters');
|
|
List.Add(C_Line);
|
|
List.Add('You can pass any parameters directly to aux driver. Use the prefix ''@'' for this, e.g.:');
|
|
List.Add('@Alias=MyDB;@Pooled=True');
|
|
List.Add('');
|
|
List.Add('Detailed description of aux driver parameters you can find at:');
|
|
List.Add('http://wiki.remobjects.com/wiki/Connect_to_IBM_DB2_Server_%28AnyDAC%29');
|
|
end;
|
|
mkASA:
|
|
begin
|
|
List.Add('ASA AuxDriver parameters');
|
|
List.Add(C_Line);
|
|
List.Add('You can pass any parameters directly to aux driver. Use the prefix ''@'' for this, e.g.:');
|
|
List.Add('@ODBCAdvanced=AutoStart=Yes;@DatabaseFile=C:\sybase\addemo_asa10.db;@Pooled=True');
|
|
List.Add('');
|
|
List.Add('Detailed description of aux driver parameters you can find at:');
|
|
List.Add('http://wiki.remobjects.com/wiki/Connect_to_Sybase_SQL_Anywhere_%28AnyDAC%29');
|
|
end;
|
|
mkInterBase:
|
|
begin
|
|
List.Add('IB/FB AuxDriver parameters');
|
|
List.Add(C_Line);
|
|
List.Add('You can pass any parameters directly to aux driver. Use the prefix ''@'' for this, e.g.:');
|
|
List.Add('@Protocol=TCPIP;@CharacterSet=win1251;@Pooled=True');
|
|
List.Add('');
|
|
List.Add('Detailed description of aux driver parameters you can find at:');
|
|
List.Add('http://wiki.remobjects.com/wiki/Connect_to_Interbase_or_Firebird_Server_%28AnyDAC%29');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACDriver.Initialize;
|
|
begin
|
|
FConnectionDefs := TStringList.Create;
|
|
FConnectionDefs.Sorted := True;
|
|
FConnectionDefIndex := 0;
|
|
ADManager.Open;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACDriver.Finalize;
|
|
begin
|
|
ADManager.Close;
|
|
{$IFDEF AnyDAC_MONITOR}
|
|
FreeAndNil(FMonitor);
|
|
{$ENDIF AnyDAC_MONITOR}
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACDriver.LookupConnectionString(const AConnectionString: String;
|
|
AParsedParams: TStringList): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := FConnectionDefs.IndexOf(AConnectionString);
|
|
if i = -1 then begin
|
|
Inc(FConnectionDefIndex);
|
|
FConnectionDefs.AddObject(AConnectionString, TObject(FConnectionDefIndex));
|
|
with ADManager.ConnectionDefs.AddConnectionDef do begin
|
|
Name := Format('__DACD_%d', [FConnectionDefIndex]);
|
|
Params.AddStrings(AParsedParams);
|
|
Result := Name;
|
|
end;
|
|
end
|
|
else
|
|
Result := Format('__DACD_%d', [Integer(FConnectionDefs.Objects[i])]);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{$IFDEF AnyDAC_MONITOR}
|
|
procedure TDAEAnyDACDriver.DoTrace(ASender: TADMoniClientLinkBase;
|
|
const AClassName, AObjName, AMessage: String);
|
|
begin
|
|
if Assigned(FTraceCallback) then
|
|
FTraceCallback(ASender, AMessage, 0);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACDriver.DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent);
|
|
var
|
|
eKinds: TADMoniEventKinds;
|
|
begin
|
|
inherited;
|
|
if TraceActive then begin
|
|
FTraceCallBack := Callback;
|
|
eKinds := [];
|
|
if toPrepare in TraceOptions then eKinds := eKinds + [ekCmdPrepare];
|
|
if toExecute in TraceOptions then eKinds := eKinds + [ekCmdExecute];
|
|
if toFetch in TraceOptions then eKinds := eKinds + [ekCmdDataIn];
|
|
if toError in TraceOptions then eKinds := eKinds + [ekError];
|
|
// if toStmt in TraceOptions then eKinds := eKinds + [tfStmt];
|
|
if toConnect in TraceOptions then eKinds := eKinds + [ekConnConnect];
|
|
if toTransact in TraceOptions then eKinds := eKinds + [ekConnTransact];
|
|
// if toBlob in TraceOptions then eKinds := eKinds + [tfBlob];
|
|
if toService in TraceOptions then eKinds := eKinds + [ekVendor];
|
|
if toMisc in TraceOptions then eKinds := eKinds + [ekConnService, ekLiveCycle, ekAdaptUpdate];
|
|
if toParams in TraceOptions then eKinds := eKinds + [ekCmdDataIn, ekCmdDataOut];
|
|
if FMonitor = nil then FMonitor := TADMoniCustomClientLink.Create(Self);
|
|
FMonitor.Tracing := False;
|
|
FMonitor.OnOutput := DoTrace;
|
|
FMonitor.EventKinds := eKinds;
|
|
FMonitor.Tracing := True;
|
|
end
|
|
else begin
|
|
if FMonitor <> nil then
|
|
FMonitor.Tracing := False;
|
|
FTraceCallback := nil;
|
|
end;
|
|
end;
|
|
{$ENDIF AnyDAC_MONITOR}
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TDAEAnyDACConnection }
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.QueryInterface(const IID: TGUID; out Obj): HResult;
|
|
begin
|
|
Result := E_NOINTERFACE;
|
|
if IsEqualGUID(IID, IDAADOConnection) then begin
|
|
if fDriverType <> mkMSSQL then Exit;
|
|
end else if IsEqualGUID(IID, IDAInterbaseConnection) then begin
|
|
if fDriverType <> mkInterbase then Exit;
|
|
end else if IsEqualGUID(IID, IDAIBTransactionAccess) then begin
|
|
if fDriverType <> mkInterbase then Exit;
|
|
end else if IsEqualGUID(IID, IDAIBConnectionProperties) then begin
|
|
if fDriverType <> mkInterbase then Exit;
|
|
end else if IsEqualGUID(IID, IDAOracleConnection) then begin
|
|
if fDriverType <> mkOracle then Exit;
|
|
end else if IsEqualGUID(IID, IDADB2Connection) then begin
|
|
if fDriverType <> mkDB2 then Exit;
|
|
end else if IsEqualGUID(IID, IDASybaseConnection) then begin
|
|
if not (fDriverType in [mkASA, mkADS]) then Exit;
|
|
end else if IsEqualGUID(IID, IDAMySQLConnection) then begin
|
|
if fDriverType <> mkMySQL then Exit;
|
|
end else if IsEqualGUID(IID, IDACanQueryDatabaseNames) then begin
|
|
if (fDriverType in [mkInterBase, mkMSAccess]) then Exit;
|
|
end else if IsEqualGUID(IID, IDAFileBasedDatabase) then begin
|
|
if not (fDriverType in [mkInterBase,mkMSAccess]) then Exit;
|
|
end else if IsEqualGUID(IID, IDAUseGenerators) then begin
|
|
if not (fDriverType in [mkInterBase, mkOracle]) then Exit;
|
|
end else if IsEqualGUID(IID, IDACanQueryGeneratorsNames) then begin
|
|
if not (fDriverType in [mkInterBase]) then Exit;
|
|
end
|
|
// else if IsEqualGUID(IID, IDAConnectionModelling) then
|
|
;
|
|
Result := inherited QueryInterface(IID, Obj);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
if FDirectMode then
|
|
result := TDAEAnyDACQueryNative
|
|
else
|
|
result := TDAEAnyDACQuery;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
if FDirectMode then
|
|
result := TDAEAnyDACStoredProcedureNative
|
|
else
|
|
result := TDAEAnyDACStoredProcedure;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.CreateCustomConnection: TCustomConnection;
|
|
begin
|
|
fDriverType := mkUnknown;
|
|
FADConnection := TADConnection.Create(nil);
|
|
FADConnection.LoginPrompt := False;
|
|
result := FADConnection;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.GetAnyDACPhysConnection: IADPhysConnection;
|
|
begin
|
|
Result := FADConnection.ConnectionIntf;
|
|
if Result = nil then
|
|
ADPhysManager.CreateConnection(FADConnection.ConnectionDefName, Result);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
|
|
{
|
|
Database= S_AD_ConnParam_Common_Database
|
|
User_Name= S_AD_ConnParam_Common_UserName
|
|
Password= S_AD_ConnParam_Common_Password
|
|
|
|
Oracle
|
|
======
|
|
OSAuthent= S_AD_ConnParam_Common_OSAuthent
|
|
DriverID=Ora
|
|
|
|
MSAccess
|
|
========
|
|
SystemDB= S_AD_ConnParam_MSAcc_SysDB
|
|
DriverID=MSAcc
|
|
|
|
DB2
|
|
===
|
|
Alias= S_AD_ConnParam_DB2_Alias
|
|
Server= S_AD_ConnParam_Common_Server
|
|
Port= S_AD_ConnParam_Common_Port
|
|
Protocol= S_AD_ConnParam_DB2_Protocol
|
|
DriverID=DB2
|
|
|
|
ASA
|
|
===
|
|
Server= S_AD_ConnParam_Common_Server
|
|
DatabaseFile= S_AD_ConnParam_ASA_DatabaseFile
|
|
OSAuthent= S_AD_ConnParam_Common_OSAuthent
|
|
App= S_AD_ConnParam_ASA_App
|
|
Compress= S_AD_ConnParam_ASA_Compress
|
|
Encrypt= S_AD_ConnParam_ASA_Encrypt
|
|
DriverID=ASA
|
|
|
|
ADS
|
|
===
|
|
DefaultType=
|
|
ServerTypes=
|
|
DriverID=ADS
|
|
|
|
MSSQL
|
|
=====
|
|
Server= S_AD_ConnParam_Common_Server
|
|
Network= S_AD_ConnParam_MSSQL_Network
|
|
Address= S_AD_ConnParam_MSSQL_Address
|
|
OSAuthent= S_AD_ConnParam_Common_OSAuthent
|
|
Workstation= S_AD_ConnParam_MSSQL_Workstation
|
|
App= S_AD_ConnParam_MSSQL_App
|
|
Encrypt= S_AD_ConnParam_MSSQL_Encrypt
|
|
Language= S_AD_ConnParam_MSSQL_Language
|
|
DriverID=MSSQL
|
|
|
|
MySQL
|
|
=====
|
|
CharacterSet= S_AD_ConnParam_Common_CharacterSet
|
|
Server= S_AD_ConnParam_Common_Server
|
|
Port= S_AD_ConnParam_Common_Port
|
|
DriverID=MySQL
|
|
|
|
IB
|
|
==
|
|
Protocol= S_AD_ConnParam_IB_Protocol
|
|
Server= S_AD_ConnParam_Common_Server
|
|
InstanceName= S_AD_ConnParam_IB_InstanceName
|
|
CharacterSet= S_AD_ConnParam_Common_CharacterSet
|
|
RoleName= S_AD_ConnParam_IB_RoleName
|
|
SQLDialect= S_AD_ConnParam_IB_SQLDialect
|
|
DriverID=IB
|
|
|
|
Other
|
|
=====
|
|
ODBCDriver=
|
|
DataSource=
|
|
RDBMS=
|
|
ODBCAdvanced=
|
|
DriverID=ODBC
|
|
}
|
|
|
|
procedure TDAEAnyDACConnection.DoApplyConnectionString(
|
|
aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
|
|
var
|
|
sName, sValue: string;
|
|
i: integer;
|
|
oParams: TStringList;
|
|
begin
|
|
fDriverType := mkUnknown;
|
|
FDataTypeSchema := '';
|
|
fMSSQLSchemaEnabled := False;
|
|
fBiDirectionalDataSets := False;
|
|
fDirectMode := False;
|
|
|
|
inherited DoApplyConnectionString(aConnStrParser, aConnectionObject);
|
|
oParams := TStringList.Create;
|
|
try
|
|
with aConnStrParser do begin
|
|
oParams.Values[S_AD_ConnParam_Common_DriverID] := AuxDriver;
|
|
fDriverType := AnyDACDriverIdToAnyDACDriverType(AuxDriver);
|
|
|
|
if (Self.UserID <> '') then
|
|
oParams.Values[S_AD_ConnParam_Common_UserName] := Self.UserID
|
|
else if (UserID <> '') then
|
|
oParams.Values[S_AD_ConnParam_Common_UserName] := UserID;
|
|
|
|
if (Self.Password <> '') then
|
|
oParams.Values[S_AD_ConnParam_Common_Password] := Self.Password
|
|
else if (Password <> '') then
|
|
oParams.Values[S_AD_ConnParam_Common_Password] := Password;
|
|
|
|
if Database <> '' then
|
|
oParams.Values[S_AD_ConnParam_Common_Database] := Database;
|
|
|
|
if Server <> '' then
|
|
oParams.Values[S_AD_ConnParam_Common_Server] := Server;
|
|
|
|
for i := 0 to AuxParamsCount - 1 do begin
|
|
sName := AuxParamNames[i];
|
|
if sName = '' then Continue;
|
|
sValue := AuxParams[AuxParamNames[i]];
|
|
if SameText(sName, 'Schemas') then begin
|
|
fMSSQLSchemaEnabled := sValue = '1';
|
|
Continue;
|
|
end
|
|
else if SameText(sName, 'Dialect') then begin
|
|
if fDriverType = mkInterBase then
|
|
sName := S_AD_ConnParam_IB_SQLDialect;
|
|
end
|
|
else if SameText(sName, 'Role') then begin
|
|
if fDriverType = mkInterBase then
|
|
sName := S_AD_ConnParam_IB_RoleName;
|
|
end
|
|
else if SameText(sName, 'Charset') then begin
|
|
if fDriverType = mkInterBase then
|
|
sName := S_AD_ConnParam_Common_CharacterSet;
|
|
end
|
|
else if SameText(sName, 'Port') then begin
|
|
if StrToIntDef(sValue, -1) <> -1 then
|
|
sName := S_AD_ConnParam_Common_Port;
|
|
end
|
|
else if SameText(sName, 'ConnectionDefName') then
|
|
sName := S_AD_DefinitionParam_Common_ConnectionDef
|
|
else if SameText(sName, 'DataTypeSchema') then begin
|
|
if fDriverType = mkInterBase then
|
|
FDataTypeSchema := UpperCase(sValue);
|
|
end
|
|
else if SameText(sName, 'Integrated Security') then begin
|
|
if (fDriverType = mkMSSQL) and (sValue = 'SSPI') then begin
|
|
sName := S_AD_ConnParam_Common_OSAuthent;
|
|
sValue := 'Yes';
|
|
end
|
|
else
|
|
Continue;
|
|
end
|
|
else if SameText(sName, 'BiDirectionalDataSets') then begin
|
|
fBiDirectionalDataSets := sValue = '1';
|
|
Continue;
|
|
end
|
|
else if SameText(sName, 'DirectMode') then begin
|
|
fDirectMode := sValue = '1';
|
|
Continue;
|
|
end
|
|
else
|
|
if sName[1] = '@' then
|
|
sName := Pchar(sName) + 1;
|
|
oParams.Values[sName] := sValue;
|
|
end;
|
|
end;
|
|
|
|
FADConnection.ConnectionDefName :=
|
|
TDAEAnyDACDriver(Driver).LookupConnectionString(GetConnectionString, oParams);
|
|
|
|
if FDataTypeSchema = 'FIB' then
|
|
MapAsFIB;
|
|
finally
|
|
oParams.Free;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.MapAsFIB;
|
|
begin
|
|
with FADConnection.FormatOptions do begin
|
|
OwnMapRules := True;
|
|
MapRules.Clear;
|
|
with MapRules.Add do begin
|
|
SourceDataType := dtFmtBCD;
|
|
TargetDataType := dtDouble;
|
|
end;
|
|
with MapRules.Add do begin
|
|
SourceDataType := dtCurrency;
|
|
TargetDataType := dtDouble;
|
|
end;
|
|
with MapRules.Add do begin
|
|
SourceDataType := dtBCD;
|
|
TargetDataType := dtBCD;
|
|
end;
|
|
with MapRules.Add do begin
|
|
SourceDataType := dtInt64;
|
|
TargetDataType := dtBCD;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.DoBeginTransaction: integer;
|
|
begin
|
|
Result := 0;
|
|
FADConnection.StartTransaction;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.DoCommitTransaction;
|
|
begin
|
|
FADConnection.Commit;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.DoRollbackTransaction;
|
|
begin
|
|
FADConnection.Rollback;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.DoGetInTransaction: boolean;
|
|
begin
|
|
result := FADConnection.InTransaction;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.Native_DoGetLastAutoInc(const GeneratorName: string): integer;
|
|
var
|
|
v: Variant;
|
|
begin
|
|
v := FADConnection.GetLastAutoGenValue(GeneratorName);
|
|
if VarIsNull(v) then
|
|
Result := -1
|
|
else
|
|
Result := v;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.DoGetLastAutoInc(const GeneratorName: string): integer;
|
|
begin
|
|
case fDriverType of
|
|
mkOracle: Result := Oracle_DoGetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
mkMSSQL: Result := MSSQL_DoGetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
mkMySQL: Result := MySQL_GetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
mkInterBase: Result := IB_GetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
else
|
|
Result := Native_DoGetLastAutoInc(GeneratorName);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.DoGetStoredProcedureNames(out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
case fDriverType of
|
|
mkOracle: Oracle_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure);
|
|
mkMSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure, fMSSQLSchemaEnabled);
|
|
mkMySQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure, FADConnection.ResultConnectionDef.Database);
|
|
mkInterbase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotProcedure);
|
|
else
|
|
DoGetNames(List, dotProcedure);
|
|
end
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.DoGetViewNames(out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
case fDriverType of
|
|
mkOracle: Oracle_DoGetNames(GetDatasetClass.Create(Self), List, dotView);
|
|
mkMSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotView, fMSSQLSchemaEnabled);
|
|
mkMySQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotView, FADConnection.ResultConnectionDef.Database);
|
|
mkInterbase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotView);
|
|
else
|
|
DoGetNames(List, dotView);
|
|
end
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.DoGetTableNames(out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
case fDriverType of
|
|
mkOracle: Oracle_DoGetNames(GetDatasetClass.Create(Self), List, dotTable);
|
|
mkMSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotTable, fMSSQLSchemaEnabled);
|
|
mkMySQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotTable, FADConnection.ResultConnectionDef.Database);
|
|
mkInterbase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotTable);
|
|
else
|
|
DoGetNames(List, dotTable);
|
|
end
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.Native_DoGetTableFields(aTableName: string; out Fields: TDAFieldCollection);
|
|
var
|
|
oMIQ: TADMetaInfoQuery;
|
|
eAttrs: TADDataAttributes;
|
|
eBlobType: TDABlobType;
|
|
lUseROWIDAsPK: Boolean;
|
|
oFld: TDAField;
|
|
begin
|
|
aTableName := QuoteIdentifierIfNeeded(aTableName);
|
|
Fields := TDAFieldCollection.Create(nil);
|
|
lUseROWIDAsPK := False;
|
|
oMIQ := TADMetaInfoQuery.Create(nil);
|
|
try
|
|
oMIQ.Connection := FADConnection;
|
|
oMIQ.ObjectName := aTableName;
|
|
oMIQ.MetaInfoKind := mkTableFields;
|
|
oMIQ.Open;
|
|
while not oMIQ.Eof do begin
|
|
with Fields.Add do begin
|
|
Name := oMIQ.FieldByName('COLUMN_NAME').AsString;
|
|
Size := oMIQ.FieldByName('COLUMN_LENGTH').AsInteger;
|
|
eAttrs := TADDataAttributes({$IFDEF FPC}ord{$ELSE}Word{$ENDIF}(oMIQ.FieldByName('COLUMN_ATTRIBUTES').AsInteger));
|
|
DataType := MapAD2DADataType(TADDataType(oMIQ.FieldByName('COLUMN_DATATYPE').AsInteger), eBlobType);
|
|
if eBlobType <> dabtUnknown then
|
|
BlobType := eBlobType;
|
|
if (DataType = datInteger) and (caAutoInc in eAttrs) then
|
|
DataType := datAutoInc;
|
|
Required := not (caAllowNull in eAttrs);
|
|
ReadOnly := caReadOnly in eAttrs;
|
|
if caROWID in eAttrs then begin
|
|
InPrimaryKey := True;
|
|
lUseROWIDAsPK := True;
|
|
end;
|
|
// DefaultValue
|
|
// ServerAutoRefresh
|
|
end;
|
|
oMIQ.Next;
|
|
end;
|
|
|
|
if not lUseROWIDAsPK then begin
|
|
oMIQ.Close;
|
|
oMIQ.BaseObjectName := oMIQ.ObjectName;
|
|
oMIQ.ObjectName := '';
|
|
oMIQ.MetaInfoKind := mkPrimaryKeyFields;
|
|
oMIQ.Open;
|
|
while not oMIQ.Eof do begin
|
|
oFld := Fields.FindField(oMIQ.FieldByName('COLUMN_NAME').AsString);
|
|
if oFld <> nil then
|
|
oFld.InPrimaryKey := True;
|
|
oMIQ.Next;
|
|
end;
|
|
end;
|
|
|
|
finally
|
|
oMIQ.Free;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.Native_DoGetForeignKeys(ForeignKeys: TDADriverForeignKeyCollection);
|
|
var
|
|
oTabs, oFKeys, oFKeyFields: TADMetaInfoQuery;
|
|
sFKFields, sPKFields: String;
|
|
oConnMeta: IADPhysConnectionMetadata;
|
|
|
|
function QuoteName(const AName: String): String;
|
|
begin
|
|
if AName = '' then
|
|
Result := ''
|
|
else
|
|
Result := oConnMeta.NameQuotaChar1 + AName + oConnMeta.NameQuotaChar2;
|
|
end;
|
|
|
|
begin
|
|
GetAnyDACPhysConnection.CreateMetadata(oConnMeta);
|
|
ForeignKeys := TDADriverForeignKeyCollection.Create(nil);
|
|
oTabs := TADMetaInfoQuery.Create(nil);
|
|
oFKeys := TADMetaInfoQuery.Create(nil);
|
|
oFKeyFields := TADMetaInfoQuery.Create(nil);
|
|
try
|
|
oTabs.Connection := FADConnection;
|
|
oTabs.MetaInfoKind := mkTables;
|
|
oTabs.TableKinds := [tkTable, tkTempTable, tkLocalTable];
|
|
oFKeys.MetaInfoKind := mkForeignKeys;
|
|
oFKeys.Connection := FADConnection;
|
|
oFKeys.MetaInfoKind := mkForeignKeys;
|
|
oFKeyFields.Connection := FADConnection;
|
|
oFKeyFields.MetaInfoKind := mkForeignKeyFields;
|
|
oTabs.Open;
|
|
while not oTabs.Eof do begin
|
|
oFKeys.Close;
|
|
oFKeys.CatalogName := QuoteName(oTabs.Fields[1].AsString);
|
|
oFKeys.SchemaName := QuoteName(oTabs.Fields[2].AsString);
|
|
oFKeys.ObjectName := QuoteName(oTabs.Fields[3].AsString);
|
|
oFKeys.Open;
|
|
while not oFKeys.Eof do begin
|
|
oFKeyFields.Close;
|
|
oFKeyFields.CatalogName := QuoteName(oFKeys.Fields[1].AsString);
|
|
oFKeyFields.SchemaName := QuoteName(oFKeys.Fields[2].AsString);
|
|
oFKeyFields.BaseObjectName := QuoteName(oFKeys.Fields[3].AsString);
|
|
oFKeyFields.ObjectName := QuoteName(oFKeys.Fields[4].AsString);
|
|
oFKeyFields.Open;
|
|
sPKFields := '';
|
|
sFKFields := '';
|
|
while not oFKeyFields.Eof do begin
|
|
if sPKFields <> '' then
|
|
sPKFields := sPKFields + ',';
|
|
sPKFields := sPKFields + oFKeyFields.Fields[6].AsString;
|
|
if sFKFields <> '' then
|
|
sFKFields := sFKFields + ',';
|
|
sFKFields := sFKFields + oFKeyFields.Fields[5].AsString;
|
|
oFKeyFields.Next;
|
|
end;
|
|
with ForeignKeys.Add do begin
|
|
PKTable := FADConnection.EncodeObjectName(oFKeys.Fields[5].AsString,
|
|
oFKeys.Fields[6].AsString, '', oFKeys.Fields[7].AsString);
|
|
PKField := sPKFields;
|
|
FKTable := FADConnection.EncodeObjectName(oFKeys.Fields[1].AsString,
|
|
oFKeys.Fields[2].AsString, '', oFKeys.Fields[3].AsString);
|
|
FKField := sFKFields;
|
|
end;
|
|
oFKeys.Next;
|
|
end;
|
|
oTabs.Next;
|
|
end;
|
|
finally
|
|
oTabs.Free;
|
|
oFKeys.Free;
|
|
oFKeyFields.Free;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.DoGetNames(AList: IROStrings; AObjectType: TDAObjecttype);
|
|
begin
|
|
case AObjectType of
|
|
dotTable: FADConnection.GetTableNames('', '', '', AList.Strings, [osMy], [tkTable]);
|
|
dotProcedure: FADConnection.GetStoredProcNames('', '', '', '', AList.Strings, [osMy]);
|
|
dotView: FADConnection.GetTableNames('', '', '', AList.Strings, [osMy], [tkView]);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.DoGetTableFields(const aTableName: string;
|
|
out Fields: TDAFieldCollection);
|
|
begin
|
|
case fDriverType of
|
|
mkOracle: Oracle_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
|
|
mkMSSQL: MSSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
|
|
mkMySQL: MYSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName),GetDatasetClass.Create(Self),Fields, FADConnection.ResultConnectionDef.Database);
|
|
mkInterBase: IB_GetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
|
|
else
|
|
Native_DoGetTableFields(aTableName,Fields);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.DoGetStoredProcedureParams(
|
|
const aStoredProcedureName: string; out Params: TDAParamCollection);
|
|
begin
|
|
case fDriverType of
|
|
mkMySQL: MYSQL_DoGetStoredProcedureParams(aStoredProcedureName, GetDatasetClass.Create(Self), Params, FADConnection.ResultConnectionDef.Database);
|
|
mkOracle: Oracle_DoGetStoredProcedureParams(aStoredProcedureName, GetDatasetClass.Create(Self), Params);
|
|
else
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.DoGetForeignKeys(
|
|
out ForeignKeys: TDADriverForeignKeyCollection);
|
|
begin
|
|
inherited;
|
|
case fDriverType of
|
|
mkOracle: Oracle_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys);
|
|
mkMSSQL: MSSQL_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys, fMSSQLSchemaEnabled);
|
|
mkMySQL: MYSQL_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys, FADConnection.ResultConnectionDef.Database);
|
|
mkInterBase: IB_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys);
|
|
else
|
|
Native_DoGetForeignKeys(ForeignKeys);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.CreateMacroProcessor: TDASQLMacroProcessor;
|
|
begin
|
|
case fDriverType of
|
|
mkOracle: Result := Oracle_CreateMacroProcessor;
|
|
mkMSSQL,mkMSAccess: Result := MSSQL_CreateMacroProcessor;
|
|
mkInterBase: Result := IB_CreateMacroProcessor;
|
|
else
|
|
Result := inherited CreateMacroProcessor;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
// IDAConnection
|
|
|
|
function TDAEAnyDACConnection.GetSPSelectSyntax(AHasArguments: Boolean): string;
|
|
begin
|
|
case fDriverType of
|
|
mkOracle: Result := Oracle_GetSPSelectSyntax(AHasArguments);
|
|
mkMSSQL: Result := MSSQL_GetSPSelectSyntax(AHasArguments);
|
|
mkInterBase: Result := IB_GetSPSelectSyntax(AHasArguments);
|
|
else
|
|
Result := inherited GetSPSelectSyntax(AHasArguments);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.Native_GetQuoteChars: TDAQuoteCharArray;
|
|
var
|
|
oConnMeta: IADPhysConnectionMetadata;
|
|
begin
|
|
GetAnyDACPhysConnection.CreateMetadata(oConnMeta);
|
|
result[0] := oConnMeta.NameQuotaChar1;
|
|
result[1] := oConnMeta.NameQuotaChar2;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.GetQuoteChars: TDAQuoteCharArray;
|
|
begin
|
|
case fDriverType of
|
|
mkMSSQL: Result := MSSQL_GetQuoteChars;
|
|
mkOracle: Result := Oracle_GetQuoteChars;
|
|
else
|
|
Result := Native_GetQuoteChars;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.IdentifierNeedsQuoting(const AIdentifier: string): boolean;
|
|
begin
|
|
Result := inherited IdentifierNeedsQuoting(AIdentifier);
|
|
if not Result then
|
|
case fDriverType of
|
|
mkORACLE: Result := Oracle_IdentifierNeedsQuoting(AIdentifier);
|
|
mkMSSQL: Result := MSSQL_IdentifierNeedsQuoting(AIdentifier);
|
|
mkMySQL: Result := MYSQL_IdentifierNeedsQuoting(AIdentifier);
|
|
mkInterBase: Result := IB_IdentifierNeedsQuoting(AIdentifier, GetSQLDialect);
|
|
mkDB2: Result := DB2_IdentifierNeedsQuoting(AIdentifier);
|
|
mkASA,mkADS: Result := Sybase_IdentifierNeedsQuoting(AIdentifier);
|
|
else
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
// IDAADOConnection
|
|
|
|
function TDAEAnyDACConnection.GetCommandTimeout: Integer;
|
|
begin
|
|
Result := Integer(FADConnection.ResourceOptions.CmdExecTimeout);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.SetCommandTimeout(const Value: Integer);
|
|
begin
|
|
FADConnection.ResourceOptions.CmdExecTimeout := Value;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.GetProviderName: string;
|
|
begin
|
|
Result := FADConnection.ResultConnectionDef.DriverID;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.GetProviderType: TDAOleDBProviderType;
|
|
var
|
|
s: String;
|
|
begin
|
|
s := GetProviderName;
|
|
if SameText(s, S_AD_MSSQLId) then
|
|
Result := oledb_MSSQL
|
|
else if SameText(s, S_AD_MSAccId) then
|
|
Result := oledb_Jet
|
|
else if SameText(s, S_AD_OraId) then
|
|
Result := oledb_Oracle
|
|
else if SameText(s, S_AD_ODBCId) then
|
|
Result := oledb_ODBC
|
|
else
|
|
Result := oledb_Unknown;
|
|
// oledb_MSSQL2005
|
|
// oledb_Postgresql
|
|
// oleDb_VisualFoxPro
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
// IDAIBTransactionAccess
|
|
|
|
function TDAEAnyDACConnection.GetTransaction: TObject;
|
|
begin
|
|
Result := FADConnection.Transaction;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
// IDAIBConnectionProperties
|
|
|
|
function TDAEAnyDACConnection.GetSQLDialect: integer;
|
|
begin
|
|
Result := StrToIntDef(FADConnection.Params.Values[S_AD_ConnParam_IB_SQLDialect],3);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.SetSQLDialect(Value: integer);
|
|
begin
|
|
FADConnection.Params.Values[S_AD_ConnParam_IB_SQLDialect] := IntToStr(Value);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.GetCharset: string;
|
|
begin
|
|
Result := FADConnection.Params.Values[S_AD_ConnParam_Common_CharacterSet];
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.SetCharset(const Value: string);
|
|
begin
|
|
FADConnection.Params.Values[S_AD_ConnParam_Common_CharacterSet] := Value;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.GetRole: string;
|
|
begin
|
|
Result := FADConnection.Params.Values[S_AD_ConnParam_IB_RoleName];
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.SetRole(const Value: string);
|
|
begin
|
|
FADConnection.Params.Values[S_AD_ConnParam_IB_RoleName] := Value;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.Commit;
|
|
begin
|
|
Self.DoCommitTransaction;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.Rollback;
|
|
begin
|
|
Self.DoRollbackTransaction;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.CommitRetaining;
|
|
begin
|
|
FADConnection.CommitRetaining;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.RollbackRetaining;
|
|
begin
|
|
FADConnection.RollbackRetaining;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
// IDAConnectionModelling
|
|
|
|
function TDAEAnyDACConnection.FieldToDeclaration(aField: TDAField): string;
|
|
begin
|
|
Result := '';
|
|
case fDriverType of
|
|
mkMSSQL:
|
|
case aField.DataType of
|
|
datString: result := Format('varchar(%d)', [aField.Size]);
|
|
datDateTime: result := 'datetime';
|
|
datFloat: result := 'float';
|
|
datCurrency: result := 'money';
|
|
datAutoInc: result := 'int IDENTITY(1,1)';
|
|
datInteger: result := 'int';
|
|
datLargeInt: result := 'bigint';
|
|
datBoolean: result := 'bit';
|
|
datMemo: result := 'text';
|
|
datBlob: result := 'image';
|
|
datWideString: result := Format('nvarchar(%d)', [aField.Size]);
|
|
datWideMemo: result := 'ntext';
|
|
datLargeAutoInc: result := 'bigint IDENTITY(1,1)';
|
|
datByte: result := 'smallint';
|
|
datShortInt: result := 'smallint';
|
|
datWord: result := 'int';
|
|
datSmallInt: result := 'smallint';
|
|
datCardinal: result := 'bigint';
|
|
datLargeUInt: result := 'bigint';
|
|
datGuid: result := 'uniqueidentifier';
|
|
datXml: result := 'ntext';
|
|
datDecimal: result := 'decimal';
|
|
datSingleFloat: result := 'real';
|
|
end;
|
|
|
|
mkOracle:
|
|
case aField.DataType of
|
|
datString: result := Format('varchar2(%d)', [aField.Size]);
|
|
datDateTime: result := 'date';
|
|
datFloat: result := 'float';
|
|
datCurrency: result := 'number(19,4)';
|
|
datAutoInc: result := 'number(10,0)';
|
|
datInteger: result := 'number(10,0)';
|
|
datLargeInt: result := 'number(19,0)';
|
|
datBoolean: result := 'number(1)';
|
|
datMemo,
|
|
datBlob:
|
|
case aField.BlobType of
|
|
dabtBlob: result := 'long raw';
|
|
dabtMemo: result := 'long';
|
|
dabtOraBlob: result := 'blob';
|
|
dabtOraClob: result := 'clob';
|
|
else if aField.DataType = datMemo then result := 'long' else result := 'long raw';
|
|
end;
|
|
datWideString: result := Format('nvarchar2(%d)', [aField.Size]);
|
|
datWideMemo: result := 'nclob';
|
|
datLargeAutoInc: result := 'number(19,0)';
|
|
datByte: result := 'number(3,0)';
|
|
datShortInt: result := 'number(3,0)';
|
|
datWord: result := 'number(5,0)';
|
|
datSmallInt: result := 'number(5,0)';
|
|
datCardinal: result := 'number(10,0)';
|
|
datLargeUInt: result := 'number(19,0)';
|
|
datGuid: result := 'varchar2(38)';
|
|
datXml: result := 'XMLType';
|
|
datDecimal: result := 'number';
|
|
datSingleFloat: result := 'float';
|
|
end;
|
|
|
|
mkMySQL:
|
|
case aField.DataType of
|
|
datString: result := Format('varchar(%d)', [aField.Size]);
|
|
datDateTime: result := 'datetime';
|
|
datFloat: result := 'double';
|
|
datCurrency: result := 'decimal(19,4)';
|
|
datAutoInc: result := 'int auto_increment';
|
|
datInteger: result := 'int';
|
|
datLargeInt: result := 'bigint';
|
|
datBoolean: result := 'bool';
|
|
datMemo: result := 'longtext';
|
|
datBlob: result := 'longblob';
|
|
datWideString: result := Format('varchar(%d) character set utf8', [aField.Size]);
|
|
datWideMemo: result := 'longtext character set utf8';
|
|
datLargeAutoInc: result := 'bigint auto_increment';
|
|
datByte: result := 'tinyint unsigned';
|
|
datShortInt: result := 'tinyint';
|
|
datWord: result := 'smallint unsigned';
|
|
datSmallInt: result := 'smallint';
|
|
datCardinal: result := 'int unsigned';
|
|
datLargeUInt: result := 'bigint unsigned';
|
|
datGuid: result := 'varchar(38)';
|
|
datXml: result := 'longtext';
|
|
datDecimal: result := 'decimal';
|
|
datSingleFloat: result := 'float';
|
|
end;
|
|
|
|
mkMSAccess:
|
|
case aField.DataType of
|
|
datString: result := Format('varchar(%d)', [aField.Size]);
|
|
datDateTime: result := 'datetime';
|
|
datFloat: result := 'float';
|
|
datCurrency: result := 'currency';
|
|
datAutoInc: result := 'IDENTITY(1,1)';
|
|
datInteger: result := 'integer';
|
|
datLargeInt: result := 'decimal(19,0)';
|
|
datBoolean: result := 'boolean';
|
|
datMemo: result := 'memo';
|
|
datBlob: result := 'image';
|
|
datWideString: result := Format('nchar(%d)', [aField.Size]);
|
|
datWideMemo: result := 'ntext';
|
|
datLargeAutoInc: result := 'IDENTITY(1,1)';
|
|
datByte: result := 'byte';
|
|
datShortInt: result := 'tinyint';
|
|
datWord: result := 'smallint';
|
|
datSmallInt: result := 'smallint';
|
|
datCardinal: result := 'integer';
|
|
datLargeUInt: result := 'decimal(19,0)';
|
|
datGuid: result := 'varchar(38)';
|
|
datXml: result := 'ntext';
|
|
datDecimal: result := 'decimal';
|
|
datSingleFloat: result := 'real';
|
|
end;
|
|
|
|
mkDB2:
|
|
case aField.DataType of
|
|
datString: result := Format('varchar(%d)', [aField.Size]);
|
|
datDateTime: result := 'timestamp';
|
|
datFloat: result := 'real';
|
|
datCurrency: result := 'decimal(19,4)';
|
|
datAutoInc: result := 'integer not null generated always as identity (start with 1, increment by 1, no cache)';
|
|
datInteger: result := 'integer';
|
|
datLargeInt: result := 'bigint'; // >= 9.1
|
|
datBoolean: result := 'smallint';
|
|
datMemo,
|
|
datBlob:
|
|
case aField.BlobType of
|
|
dabtBlob: result := 'long varchar for bit data';
|
|
dabtMemo: result := 'long varchar ';
|
|
dabtOraBlob: result := 'blob';
|
|
dabtOraClob: result := 'clob';
|
|
else if aField.DataType = datMemo then result := 'long varchar' else result := 'long varchar for bit data';
|
|
end;
|
|
datWideString: result := Format('vargraphic(%d)', [aField.Size]);
|
|
datWideMemo: result := 'clob';
|
|
datLargeAutoInc: result := 'bigint not null generated always as identity (start with 1, increment by 1, no cache)'; // >= 9.1
|
|
datByte: result := 'smallint';
|
|
datShortInt: result := 'smallint';
|
|
datWord: result := 'smallint';
|
|
datSmallInt: result := 'smallint';
|
|
datCardinal: result := 'integer';
|
|
datLargeUInt: result := 'bigint'; // >= 9.1
|
|
datGuid: result := 'varchar(38)';
|
|
datXml: result := 'clob';
|
|
datDecimal: result := 'number';
|
|
datSingleFloat: result := 'real';
|
|
end;
|
|
|
|
mkASA:
|
|
case aField.DataType of
|
|
datString: result := Format('varchar(%d)', [aField.Size]);
|
|
datDateTime: result := 'timestamp';
|
|
datFloat: result := 'double';
|
|
datCurrency: result := 'money';
|
|
datAutoInc: result := 'integer identity(1,1)';
|
|
datInteger: result := 'integer';
|
|
datLargeInt: result := 'bigint';
|
|
datBoolean: result := 'bit';
|
|
datMemo: result := 'text';
|
|
datBlob: result := 'image';
|
|
datWideString: result := Format('nvarchar(%d)', [aField.Size]);
|
|
datWideMemo: result := 'ntext';
|
|
datLargeAutoInc: result := 'bigint identity(1,1)';
|
|
datByte: result := 'unsigned tinyint';
|
|
datShortInt: result := 'tinyint';
|
|
datWord: result := 'unsigned smallint';
|
|
datSmallInt: result := 'smallint';
|
|
datCardinal: result := 'unsigned integer';
|
|
datLargeUInt: result := 'unsigned bigint';
|
|
datGuid: result := 'uniqueidentifierstr';
|
|
datXml: result := 'xml';
|
|
datDecimal: result := 'decimal';
|
|
datSingleFloat: result := 'real';
|
|
end;
|
|
|
|
mkInterbase:
|
|
case aField.DataType of
|
|
datString: result := Format('varchar(%d)', [aField.Size]);
|
|
datDateTime: result := 'timestamp';
|
|
datFloat: result := 'double precision';
|
|
datCurrency: result := 'decimal(18,4)';
|
|
datAutoInc: result := 'integer';
|
|
datInteger: result := 'integer';
|
|
datLargeInt: result := 'decimal(18,0)';
|
|
datBoolean: result := 'integer check (value in (0, 1))';
|
|
datMemo,
|
|
datBlob:
|
|
case aField.BlobType of
|
|
dabtBlob: result := 'blob(2000,0)';
|
|
dabtMemo: result := 'blob(2000,1)';
|
|
dabtOraBlob: result := 'blob(2000,0)';
|
|
dabtOraClob: result := 'blob(2000,1)';
|
|
else if aField.DataType = datMemo then result := 'blob(2000,1)' else result := 'blob(2000,0)';
|
|
end;
|
|
datWideString: result := Format('varchar(%d) character set unicode_fss', [aField.Size]);
|
|
datWideMemo: result := 'blob sub_type 1 segment size 2000 character set unicode_fss';
|
|
datLargeAutoInc: result := 'decimal(18,0)';
|
|
datByte: result := 'smallint';
|
|
datShortInt: result := 'smallint';
|
|
datWord: result := 'smallint';
|
|
datSmallInt: result := 'smallint';
|
|
datCardinal: result := 'decimal(10,0)';
|
|
datLargeUInt: result := 'decimal(18,0)';
|
|
datGuid: result := 'varchar(38)';
|
|
datXml: result := 'blob(2000,1)';
|
|
datDecimal: result := 'decimal(18,6)';
|
|
datSingleFloat: result := 'float';
|
|
end;
|
|
end;
|
|
|
|
if Result = '' then
|
|
raise Exception.CreateFmt('DataAbstract [%d] data type of field [%s] for DBMS [%s] is not supported',
|
|
[Integer(aField.DataType), aField.Name, C_AD_PhysRDBMSKinds[fDriverType]]);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACConnection.BuildCreateTableSQL(aDataSet: TDADataSet;
|
|
const aOverrideName: string): string;
|
|
var
|
|
lName: string;
|
|
begin
|
|
lName := aOverrideName;
|
|
if lName = '' then
|
|
lName := aDataSet.Name;
|
|
result := uDAHelpers.BuildCreateStatementForTable(aDataSet, lName, self);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.CreateTable(aDataSet: TDADataSet; const aOverrideName: string);
|
|
var
|
|
sSQL: string;
|
|
begin
|
|
sSQL := BuildCreateTableSQL(aDataSet, aOverrideName);
|
|
with NewCommand(sSQL, stSQL) do
|
|
Execute();
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
// IDACanQueryDatabaseNames
|
|
|
|
function TDAEAnyDACConnection.GetDatabaseNames: IROStrings;
|
|
begin
|
|
case fDriverType of
|
|
mkMSSQL: Result := MSSQL_GetDatabaseNames(Self);
|
|
mkMySQL: Result := MYSQL_GetDatabaseNames(GetDatasetClass.Create(Self));
|
|
else
|
|
Result := NewROStrings;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
// IDAFileBasedDatabase
|
|
|
|
function TDAEAnyDACConnection.GetFileExtensions: IROStrings;
|
|
begin
|
|
case fDriverType of
|
|
mkInterBase: Result := IB_GetFileExtensions;
|
|
mkMSAccess: Result := MSACCESS_GetFileExtensions;
|
|
else
|
|
Result := NewROStrings;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
// IDAUseGenerators
|
|
|
|
function TDAEAnyDACConnection.GetNextAutoinc(const GeneratorName: string): integer;
|
|
begin
|
|
Result := -1;
|
|
case fDriverType of
|
|
mkInterBase: Result := IB_GetNextAutoinc(GeneratorName, GetDatasetClass.Create(Self));
|
|
mkOracle: Result := Oracle_GetNextAutoinc(GeneratorName, GetDatasetClass.Create(Self));
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
// IDACanQueryGeneratorsNames
|
|
|
|
function TDAEAnyDACConnection.GetGeneratorNames: IROStrings;
|
|
begin
|
|
case fDriverType of
|
|
mkInterBase: Result := IB_GetGeneratorNames(GetDatasetClass.Create(Self));
|
|
else
|
|
Result := NewROStrings;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.SetupOptions(AOptions: IADStanOptions;
|
|
AFetchMeta: Boolean);
|
|
begin
|
|
with AOptions do begin
|
|
if not fBiDirectionalDataSets then
|
|
FetchOptions.Unidirectional := True;
|
|
FetchOptions.Mode := fmAll;
|
|
if not AFetchMeta then
|
|
FetchOptions.Items := FetchOptions.Items - [fiMeta];
|
|
FetchOptions.RowsetSize := 500;
|
|
ResourceOptions.SilentMode := True;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACConnection.SetupDataset(ADataSet: TADRdbmsDataSet;
|
|
AFetchMeta: Boolean);
|
|
begin
|
|
TADQuery(ADataSet).Connection := FADConnection;
|
|
SetupOptions(IADStanOptions(TADQuery(ADataSet).Command), AFetchMeta);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TDAEAnyDACQuery }
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TADQuery.Create(nil);
|
|
TDAEAnyDACConnection(aConnection).SetupDataset(TADQuery(result), False);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACQuery.DoPrepare(AValue: boolean);
|
|
var
|
|
i: integer;
|
|
oPar: TADParam;
|
|
begin
|
|
if AValue and not TADQuery(Dataset).Prepared and (TADQuery(Dataset).ParamCount <> 0) then
|
|
for I := 0 to GetParams.Count - 1 do begin
|
|
oPar := TADQuery(Dataset).ParamByName(GetParams[i].Name);
|
|
oPar.DataType := DATypeToVCLType(GetParams[i].DataType);
|
|
if oPar.DataType = ftAutoInc then
|
|
oPar.DataType := ftInteger;
|
|
end;
|
|
TADQuery(Dataset).Prepared := AValue;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACQuery.ClearParams;
|
|
begin
|
|
inherited;
|
|
TADQuery(Dataset).Params.Clear;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACQuery.DoExecute: integer;
|
|
begin
|
|
with TADQuery(Dataset) do begin
|
|
// 1) SELECT command on MSSQL, etc may be without result set, for example:
|
|
// SELECT :CUSTOMERS_CNT = count(*) from customers
|
|
// 2) On Oracle skExecute is handled specially (PL/SQL) and commands as
|
|
// above are not possible
|
|
if PointedConnection.RDBMSKind <> mkOracle then
|
|
Command.CommandKind := skExecute;
|
|
ExecSQL;
|
|
Result := RowsAffected;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACQuery.DoGetSQL: string;
|
|
begin
|
|
Result := TADQuery(Dataset).SQL.Text;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACQuery.DoSetSQL(const AValue: string);
|
|
begin
|
|
TADQuery(Dataset).SQL.Text := AValue;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACQuery.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
SetADParamValuesFromDA(AParams, TADQuery(Dataset).Params, True);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACQuery.GetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
GetDAParamValuesFromAD(GetParams, TADQuery(Dataset).Params);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TDAEAnyDACStoredProcedure }
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACStoredProcedure.CreateDataset(AConnection: TDAEConnection): TDataset;
|
|
begin
|
|
Result := TADStoredProc.Create(nil);
|
|
TDAEAnyDACConnection(aConnection).SetupDataset(TADStoredProc(Result), True);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACStoredProcedure.GetStoredProcedureName: string;
|
|
begin
|
|
Result := TADStoredProc(DataSet).StoredProcName;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACStoredProcedure.SetStoredProcedureName(const Name: string);
|
|
begin
|
|
TADStoredProc(DataSet).StoredProcName := Name;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACStoredProcedure.DoExecute: integer;
|
|
begin
|
|
TADStoredProc(Dataset).ExecProc;
|
|
result := TADStoredProc(Dataset).RowsAffected;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACStoredProcedure.Execute: integer;
|
|
var
|
|
oADParams: TADParams;
|
|
oDAParams: TDAParamCollection;
|
|
begin
|
|
oADParams := TADStoredProc(Dataset).Params;
|
|
oDAParams := GetParams;
|
|
if oADParams.Count <> oDAParams.Count then
|
|
TADStoredProc(Dataset).Prepare;
|
|
SetADParamValuesFromDA(oDAParams, oADParams, False);
|
|
Result := DoExecute;
|
|
GetDAParamValuesFromAD(oDAParams, oADParams);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACStoredProcedure.RefreshParams;
|
|
var
|
|
oDAParams: TDAParamCollection;
|
|
oDAParam: TDAParam;
|
|
i: Integer;
|
|
begin
|
|
TADStoredProc(Dataset).Prepare;
|
|
oDAParams := GetParams;
|
|
oDAParams.Clear;
|
|
with TADStoredProc(Dataset) do
|
|
for i := 0 to Params.Count - 1 do begin
|
|
oDAParam := oDAParams.Add;
|
|
oDAParam.Name := Params[i].Name;
|
|
oDAParam.DataType := VCLTypeToDAType(Params[i].DataType);
|
|
oDAParam.ParamType := TDAParamType(Params[i].ParamType);
|
|
oDAParam.Size := Params[i].Size;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACStoredProcedure.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
SetADParamValuesFromDA(AParams, TADStoredProc(Dataset).Params, False);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACStoredProcedure.GetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
GetDAParamValuesFromAD(AParams, TADStoredProc(Dataset).Params);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TDAEAnyDACNativeField }
|
|
{------------------------------------------------------------------------------}
|
|
constructor TDAEAnyDACNativeField.Create(ACol: TADDatSColumn; const ACmd: IADPhysCommand);
|
|
begin
|
|
inherited Create;
|
|
FCol := ACol;
|
|
FCmd := ACmd;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeField.GetDataType: TFieldType;
|
|
var
|
|
iDestSize: Longword;
|
|
iDestPrec: Integer;
|
|
begin
|
|
FCmd.Options.FormatOptions.ColumnDef2FieldDef(FCol.DataType, FCol.Scale,
|
|
FCol.Precision, FCol.Size, FCol.Attributes, Result, iDestSize, iDestPrec);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeField.GetDecimalPrecision: Integer;
|
|
begin
|
|
Result := FCol.Precision;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeField.GetDecimalScale: Integer;
|
|
begin
|
|
Result := FCol.Scale;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeField.GetFieldName: string;
|
|
begin
|
|
Result := FCol.Name;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeField.GetNativeObject: TObject;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeField.GetSize: integer;
|
|
begin
|
|
Result := FCol.Size;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeField.isTFieldCompatible: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeField.SetDataType(Value: TFieldType);
|
|
var
|
|
eDestType: TADDataType;
|
|
iDestScale: Integer;
|
|
iDestPrec: Integer;
|
|
iDestSize: LongWord;
|
|
iDestAttrs: TADDataAttributes;
|
|
begin
|
|
FCmd.Options.FormatOptions.FieldDef2ColumnDef(Value, FCol.Size, FCol.Precision,
|
|
eDestType, iDestScale, iDestPrec, iDestSize, iDestAttrs);
|
|
FCol.DataType := eDestType;
|
|
FCol.Attributes := iDestAttrs;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeField.SetDecimalPrecision(Value: integer);
|
|
begin
|
|
FCol.Precision := Value;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeField.SetDecimalScale(Value: integer);
|
|
begin
|
|
FCol.Scale := Value;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TDAEAnyDACNativeDatabaseAccess }
|
|
{------------------------------------------------------------------------------}
|
|
constructor TDAEAnyDACNativeDatabaseAccess.Create(ADAEConnection: TDAEAnyDACConnection);
|
|
begin
|
|
inherited Create;
|
|
ADAEConnection.FADConnection.ConnectionIntf.CreateCommand(FCmd);
|
|
FTab := TADDatSTable.Create;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
destructor TDAEAnyDACNativeDatabaseAccess.Destroy;
|
|
begin
|
|
FCmd := nil;
|
|
FreeAndNil(FTab);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess._AddRef: Integer;
|
|
begin
|
|
Result := 1;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess._Release: Integer;
|
|
begin
|
|
Result := 1;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.QueryInterface(const IID: TGUID; out Obj): HResult;
|
|
begin
|
|
if GetInterface(IID, Obj) then
|
|
Result := 0
|
|
else
|
|
Result := E_NOINTERFACE;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeDatabaseAccess.CheckActive;
|
|
begin
|
|
if not (nfActive in FFlags) then
|
|
raise Exception.Create('Dataset must be active');
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeDatabaseAccess.CheckBidir;
|
|
begin
|
|
if FCmd.Options.FetchOptions.Unidirectional then
|
|
raise Exception.Create('Dataset must be bidirectional');
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeDatabaseAccess.ClearFieldDefs;
|
|
begin
|
|
FTab.Reset;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.GetRecordCount: Integer;
|
|
begin
|
|
Result := FRowsPurged + FTab.Rows.Count;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.GetBOF: Boolean;
|
|
begin
|
|
Result := nfBOF in FFlags;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.GetEOF: Boolean;
|
|
begin
|
|
Result := nfEOF in FFlags;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.GetActive: Boolean;
|
|
begin
|
|
Result := nfActive in FFlags;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeDatabaseAccess.SetActive(const aValue: Boolean);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if (nfActive in FFlags) <> aValue then
|
|
if aValue then begin
|
|
FCmd.Open;
|
|
FCmd.Define(FTab);
|
|
FCmd.Fetch(FTab, False);
|
|
FRowIndex := 0;
|
|
FRowsPurged := 0;
|
|
if FTab.Rows.Count = 0 then
|
|
Include(FFlags, nfEOF);
|
|
Include(FFlags, nfBOF);
|
|
Include(FFlags, nfActive);
|
|
SetLength(FBuffs, FTab.Columns.Count);
|
|
for i := 0 to FTab.Columns.Count - 1 do
|
|
case FTab.Columns[i].DataType of
|
|
dtDateTimeStamp,
|
|
dtTime,
|
|
dtDate:
|
|
GetMem(FBuffs[i], SizeOf(TDateTime));
|
|
dtGUID:
|
|
GetMem(FBuffs[i], 39);
|
|
dtCurrency:
|
|
GetMem(FBuffs[i], SizeOf(Double));
|
|
dtBCD:
|
|
GetMem(FBuffs[i], SizeOf(Currency));
|
|
else
|
|
FBuffs[i] := nil;
|
|
end;
|
|
end
|
|
else begin
|
|
FCmd.AbortJob(True);
|
|
FCmd.CloseAll;
|
|
FTab.Clear;
|
|
FRowIndex := 0;
|
|
FRowsPurged := 0;
|
|
Exclude(FFlags, nfActive);
|
|
for i := 0 to FTab.Columns.Count - 1 do
|
|
if FBuffs[i] <> nil then
|
|
FreeMem(FBuffs[i]);
|
|
SetLength(FBuffs, 0);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeDatabaseAccess.First;
|
|
begin
|
|
CheckActive;
|
|
CheckBidir;
|
|
FRowIndex := 0;
|
|
if FTab.Rows.Count = 0 then
|
|
Include(FFlags, nfEOF);
|
|
Include(FFlags, nfBOF);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeDatabaseAccess.Next;
|
|
begin
|
|
CheckActive;
|
|
Exclude(FFlags, nfEOF);
|
|
if FRowIndex >= FTab.Rows.Count - 1 then begin
|
|
if FCmd.State = csOpen then begin
|
|
if FCmd.Options.FetchOptions.Unidirectional then begin
|
|
Inc(FRowsPurged, FTab.Rows.Count);
|
|
FTab.Clear;
|
|
FRowIndex := -1;
|
|
end;
|
|
FCmd.Fetch(FTab, False);
|
|
if FCmd.RowsAffected = 0 then
|
|
Include(FFlags, nfEOF);
|
|
end
|
|
else
|
|
Include(FFlags, nfEOF);
|
|
end;
|
|
if FRowIndex < FTab.Rows.Count - 1 then
|
|
Inc(FRowIndex);
|
|
if FRowIndex <= 0 then
|
|
Include(FFlags, nfBOF)
|
|
else
|
|
Exclude(FFlags, nfBOF);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.LocateRecord(const KeyFields: string;
|
|
const KeyValues: Variant; Options: TLocateOptions; AChangePos: Boolean): Integer;
|
|
var
|
|
oCols: TADDatSColumnSublist;
|
|
iPrevRowIndex: Integer;
|
|
ePrevFlags: TDAEAnyDACNativeDatabaseAccessFlags;
|
|
lSimple: Boolean;
|
|
lEQ: Boolean;
|
|
i: Integer;
|
|
V1, V2: Variant;
|
|
begin
|
|
Result := -1;
|
|
oCols := TADDatSColumnSublist.Create;
|
|
iPrevRowIndex := FRowIndex;
|
|
ePrevFlags := FFlags;
|
|
try
|
|
oCols.Fill(FTab, KeyFields);
|
|
lSimple := (oCols.Count = 1) and VarIsArray(KeyValues);
|
|
First;
|
|
while not (nfEOF in FFlags) do begin
|
|
lEQ := False;
|
|
for i := 0 to oCols.Count - 1 do begin
|
|
V1 := FTab.Rows[FRowIndex].GetData(oCols[i]);
|
|
if lSimple then
|
|
V2 := KeyValues
|
|
else
|
|
V2 := KeyValues[i];
|
|
if VarIsNull(V1) and VarIsNull(V2) then
|
|
lEQ := True
|
|
else if VarIsNull(V1) xor VarIsNull(V2) then
|
|
lEQ := False
|
|
else if oCols[i].DataType in [dtAnsiString, dtWideString, dtMemo,
|
|
dtWideMemo, dtHMemo, dtWideHMemo] then
|
|
if loCaseInsensitive in Options then begin
|
|
if loPartialKey in Options then
|
|
lEQ := Pos(AnsiLowerCase(VarToStr(V2)), AnsiLowerCase(VarToStr(V1))) = 1
|
|
else
|
|
lEQ := AnsiCompareText(VarToStr(V2), VarToStr(V1)) = 0;
|
|
end
|
|
else if loPartialKey in Options then
|
|
lEQ := Pos(VarToStr(V2), VarToStr(V1)) = 1
|
|
else
|
|
lEQ := CompareStr(VarToStr(V2), VarToStr(V1)) = 0
|
|
else
|
|
try
|
|
lEQ := V1 = V2;
|
|
except
|
|
lEQ := False;
|
|
end;
|
|
if not lEQ then
|
|
Exit;
|
|
end;
|
|
if lEQ then begin
|
|
Result := FRowIndex;
|
|
Break;
|
|
end;
|
|
Next;
|
|
end;
|
|
finally
|
|
oCols.Free;
|
|
if (Result = -1) or not AChangePos then begin
|
|
FRowIndex := iPrevRowIndex;
|
|
FFlags := ePrevFlags;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.Locate(const KeyFields: string;
|
|
const KeyValues: Variant; Options: TLocateOptions): Boolean;
|
|
begin
|
|
Result := LocateRecord(KeyFields, KeyValues, Options, True) <> -1;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.Lookup(const KeyFields: string;
|
|
const KeyValues: Variant; const ResultFields: string): Variant;
|
|
var
|
|
iRowIndex, i: Integer;
|
|
oCols: TADDatSColumnSublist;
|
|
begin
|
|
iRowIndex := LocateRecord(KeyFields, KeyValues, [], False);
|
|
if iRowIndex <> -1 then begin
|
|
oCols := TADDatSColumnSublist.Create;
|
|
try
|
|
if oCols.Count = 1 then
|
|
Result := FTab.Rows[iRowIndex].GetData(oCols[0])
|
|
else begin
|
|
Result := VarArrayCreate([0, oCols.Count - 1], varVariant);
|
|
for i := 0 to oCols.Count - 1 do
|
|
Result[i] := FTab.Rows[iRowIndex].GetData(oCols[i]);
|
|
end;
|
|
finally
|
|
oCols.Free;
|
|
end
|
|
end
|
|
else
|
|
Result := Null;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.GetFieldName(Index: Integer): string;
|
|
begin
|
|
Result := FTab.Columns[Index].Name;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeDatabaseAccess.DisableControls;
|
|
begin
|
|
// nothing
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeDatabaseAccess.EnableControls;
|
|
begin
|
|
// nothing
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.ControlsDisabled: Boolean;
|
|
begin
|
|
// nothing
|
|
Result := True;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.GetIsEmpty: boolean;
|
|
begin
|
|
Result := (FRowsPurged + FTab.Rows.Count) = 0;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeDatabaseAccess.FreeBookmark(Bookmark: TBookmark);
|
|
begin
|
|
// nothing
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.GetBookMark: pointer;
|
|
begin
|
|
CheckActive;
|
|
CheckBidir;
|
|
Result := Pointer(FRowIndex);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeDatabaseAccess.GotoBookmark(Bookmark: TBookmark);
|
|
begin
|
|
CheckActive;
|
|
CheckBidir;
|
|
FRowIndex := Integer(Bookmark);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.GetState: TDatasetState;
|
|
begin
|
|
if FCmd.State = csExecuting then
|
|
Result := dsOpening
|
|
else if nfActive in FFlags then
|
|
Result := dsBrowse
|
|
else
|
|
Result := dsInactive;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACNativeDatabaseAccess.Prepare(const AValue: Boolean);
|
|
begin
|
|
if AValue then
|
|
FCmd.Prepare
|
|
else
|
|
FCmd.Unprepare;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.GetFields(Index: integer): IDANativeField;
|
|
begin
|
|
Result := TDAEAnyDACNativeField.Create(FTab.Columns[Index], FCmd) as IDANativeField;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.FieldCount: Integer;
|
|
begin
|
|
Result := FTab.Columns.Count;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.FindField(const FieldName: string): IDANativeField;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
i := FTab.Columns.IndexOfName(FieldName);
|
|
if i = -1 then
|
|
Result := nil
|
|
else
|
|
Result := GetFields(i);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.IsTDatasetCompatible: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.GetNativeFieldData(Index: Integer;
|
|
var Data: pointer; var DataSize: cardinal): Boolean;
|
|
|
|
procedure CvtGUID(ABuff: PChar; AGuid: PGUID);
|
|
begin
|
|
with AGuid^ do
|
|
StrLFmt(ABuff, 38,
|
|
'{%.8x-%.4x-%.4x-%.2x%.2x-%.2x%.2x%.2x%.2x%.2x%.2x}',
|
|
[D1, D2, D3, D4[0], D4[1], D4[2], D4[3], D4[4], D4[5], D4[6], D4[7]]);
|
|
end;
|
|
|
|
procedure ErrNotSupported(AType: TADDataType);
|
|
begin
|
|
raise Exception.CreateFmt('AnyDAC data type [%s] is not supported by DataAbstract',
|
|
[C_AD_DataTypeNames[AType]]);
|
|
end;
|
|
|
|
begin
|
|
CheckActive;
|
|
if (FRowIndex >= 0) and (FRowIndex < FTab.Rows.Count) then begin
|
|
Result := FTab.Rows[FRowIndex].GetData(Index, rvDefault, Data, 0, DataSize, False);
|
|
if Result then
|
|
case FTab.Columns[Index].DataType of
|
|
dtWideString,
|
|
dtWideMemo,
|
|
dtWideHMemo:
|
|
DataSize := DataSize * SizeOf(WideChar);
|
|
dtDateTimeStamp:
|
|
begin
|
|
PDateTime(FBuffs[Index])^ := ADSQLTimeStampToDateTime(PADSQLTimeStamp(Data)^);
|
|
DataSize := SizeOf(TDateTime);
|
|
Data := FBuffs[Index];
|
|
end;
|
|
dtTime:
|
|
begin
|
|
PDateTime(FBuffs[Index])^ := ADTime2DateTime(PLongint(Data)^);
|
|
DataSize := SizeOf(TDateTime);
|
|
Data := FBuffs[Index];
|
|
end;
|
|
dtDate:
|
|
begin
|
|
PDateTime(FBuffs[Index])^ := ADDate2DateTime(PLongint(Data)^);
|
|
DataSize := SizeOf(TDateTime);
|
|
Data := FBuffs[Index];
|
|
end;
|
|
dtGUID:
|
|
begin
|
|
CvtGUID(PChar(FBuffs[Index]), PGuid(Data));
|
|
DataSize := 38;
|
|
Data := FBuffs[Index];
|
|
end;
|
|
dtCurrency:
|
|
begin
|
|
PDouble(FBuffs[Index])^ := PCurrency(Data)^;
|
|
DataSize := SizeOf(Double);
|
|
Data := FBuffs[Index];
|
|
end;
|
|
dtBCD:
|
|
begin
|
|
BCDToCurr(PBCD(Data)^, PCurrency(FBuffs[Index])^);
|
|
DataSize := SizeOf(Currency);
|
|
Data := FBuffs[Index];
|
|
end;
|
|
dtRowSetRef,
|
|
dtCursorRef,
|
|
dtRowRef,
|
|
dtArrayRef,
|
|
dtParentRowRef,
|
|
dtObject:
|
|
ErrNotSupported(FTab.Columns[Index].DataType);
|
|
end;
|
|
end
|
|
else
|
|
Result := False;
|
|
if not Result then begin
|
|
DataSize := 0;
|
|
Data := nil;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.GetNativeFieldValue(Index: Integer): Variant;
|
|
begin
|
|
CheckActive;
|
|
if (FRowIndex >= 0) and (FRowIndex < FTab.Rows.Count) then
|
|
Result := FTab.Rows[FRowIndex].GetData(Index)
|
|
else
|
|
Result := Null;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACNativeDatabaseAccess.CanFreeNativeFieldData: Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TDAEAnyDACQueryNative }
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACQueryNative.GetNativeObject: TDAEAnyDACNativeDatabaseAccess;
|
|
begin
|
|
Result := TDAEAnyDACNativeDatabaseAccess(inherited NativeObject);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACQueryNative.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACQueryNative.CreateNativeDatabaseAccess: IDANativeDatabaseAccess;
|
|
begin
|
|
Supports(NativeObject, IDANativeDatabaseAccess, Result);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACQueryNative.CreateNativeObject(aConnection: TDAEConnection): TObject;
|
|
begin
|
|
Result := TDAEAnyDACNativeDatabaseAccess.Create(TDAEAnyDACConnection(aConnection));
|
|
TDAEAnyDACConnection(aConnection).SetupOptions(TDAEAnyDACNativeDatabaseAccess(Result).FCmd.Options, False);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACQueryNative.DoPrepare(AValue: boolean);
|
|
var
|
|
i: integer;
|
|
oPar: TADParam;
|
|
begin
|
|
if AValue and (NativeObject.FCmd.State <> csPrepared) and (NativeObject.FCmd.Params.Count <> 0) then
|
|
for I := 0 to GetParams.Count - 1 do begin
|
|
oPar := NativeObject.FCmd.Params.ParamByName(GetParams[i].Name);
|
|
oPar.DataType := DATypeToVCLType(GetParams[i].DataType);
|
|
if oPar.DataType = ftAutoInc then
|
|
oPar.DataType := ftInteger;
|
|
end;
|
|
if AValue then
|
|
NativeObject.FCmd.Prepare
|
|
else
|
|
NativeObject.FCmd.Unprepare;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACQueryNative.ClearParams;
|
|
begin
|
|
inherited;
|
|
NativeObject.FCmd.Params.Clear;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACQueryNative.DoExecute: integer;
|
|
var
|
|
oConnMeta: IADPhysConnectionMetadata;
|
|
begin
|
|
with NativeObject.FCmd do begin
|
|
// 1) SELECT command on MSSQL, etc may be without result set, for example:
|
|
// SELECT :CUSTOMERS_CNT = count(*) from customers
|
|
// 2) On Oracle skExecute is handled specially (PL/SQL) and commands as
|
|
// above are not possible
|
|
Connection.CreateMetadata(oConnMeta);
|
|
if oConnMeta.Kind <> mkOracle then
|
|
CommandKind := skExecute;
|
|
Execute;
|
|
if RowsAffectedReal then
|
|
Result := RowsAffected
|
|
else
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACQueryNative.DoGetSQL: string;
|
|
begin
|
|
Result := NativeObject.FCmd.CommandText;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACQueryNative.DoSetSQL(const AValue: string);
|
|
begin
|
|
NativeObject.FCmd.CommandText := AValue;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACQueryNative.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
SetADParamValuesFromDA(AParams, NativeObject.FCmd.Params, True);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACQueryNative.GetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
GetDAParamValuesFromAD(GetParams, NativeObject.FCmd.Params);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TDAEAnyDACStoredProcedureNative }
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACStoredProcedureNative.GetNativeObject: TDAEAnyDACNativeDatabaseAccess;
|
|
begin
|
|
Result := TDAEAnyDACNativeDatabaseAccess(inherited NativeObject);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACStoredProcedureNative.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACStoredProcedureNative.CreateNativeDatabaseAccess: IDANativeDatabaseAccess;
|
|
begin
|
|
Supports(NativeObject, IDANativeDatabaseAccess, Result);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACStoredProcedureNative.CreateNativeObject(aConnection: TDAEConnection): TObject;
|
|
begin
|
|
Result := TDAEAnyDACNativeDatabaseAccess.Create(TDAEAnyDACConnection(aConnection));
|
|
TDAEAnyDACNativeDatabaseAccess(Result).FCmd.CommandKind := skStoredProc;
|
|
TDAEAnyDACConnection(aConnection).SetupOptions(TDAEAnyDACNativeDatabaseAccess(Result).FCmd.Options, False);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACStoredProcedureNative.GetStoredProcedureName: string;
|
|
begin
|
|
Result := NativeObject.FCmd.CommandText;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACStoredProcedureNative.SetStoredProcedureName(const Name: string);
|
|
begin
|
|
NativeObject.FCmd.CommandText := Name;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACStoredProcedureNative.DoExecute: integer;
|
|
begin
|
|
with NativeObject.FCmd do begin
|
|
Execute();
|
|
if RowsAffectedReal then
|
|
Result := RowsAffected
|
|
else
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAEAnyDACStoredProcedureNative.Execute: integer;
|
|
var
|
|
oADParams: TADParams;
|
|
oDAParams: TDAParamCollection;
|
|
begin
|
|
oADParams := NativeObject.FCmd.Params;
|
|
oDAParams := GetParams;
|
|
if oADParams.Count <> oDAParams.Count then
|
|
NativeObject.FCmd.Prepare;
|
|
SetADParamValuesFromDA(oDAParams, oADParams, False);
|
|
Result := DoExecute;
|
|
GetDAParamValuesFromAD(oDAParams, oADParams);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACStoredProcedureNative.RefreshParams;
|
|
var
|
|
oDAParams: TDAParamCollection;
|
|
oDAParam: TDAParam;
|
|
i: Integer;
|
|
begin
|
|
NativeObject.FCmd.Prepare;
|
|
oDAParams := GetParams;
|
|
oDAParams.Clear;
|
|
with NativeObject.FCmd do
|
|
for i := 0 to Params.Count - 1 do begin
|
|
oDAParam := oDAParams.Add;
|
|
oDAParam.Name := Params[i].Name;
|
|
oDAParam.DataType := VCLTypeToDAType(Params[i].DataType);
|
|
oDAParam.ParamType := TDAParamType(Params[i].ParamType);
|
|
oDAParam.Size := Params[i].Size;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACStoredProcedureNative.GetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
SetADParamValuesFromDA(AParams, NativeObject.FCmd.Params, False);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAEAnyDACStoredProcedureNative.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
GetDAParamValuesFromAD(AParams, NativeObject.FCmd.Params);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ Registration and factory code }
|
|
{------------------------------------------------------------------------------}
|
|
var
|
|
_driver: TDAEDriver = nil;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DAPalettePageName, [TDAAnyDACDriver]);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function GetDriverObject: IDADriver;
|
|
begin
|
|
{$IFDEF DataAbstract_SchemaModelerOnly}
|
|
if not RunningInSchemaModeler then begin
|
|
result := nil;
|
|
exit;
|
|
end;
|
|
{$ENDIF}
|
|
if _driver = nil then
|
|
_driver := TDAEAnyDACDriver.Create(nil);
|
|
result := _driver;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
exports
|
|
GetDriverObject name func_GetDriverObject;
|
|
|
|
initialization
|
|
{$IFDEF FPC}
|
|
{$I DataAbstract_AnyDACDriver_Glyphs.lrs}
|
|
{$ENDIF}
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
FreeAndNil(_driver);
|
|
|
|
end.
|
|
|