Componentes.Terceros.RemObj.../internal/5.0.29.665/1/Data Abstract for Delphi/Source/Drivers/uDAAnyDACDriver.pas

1622 lines
61 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}
{$R DataAbstract_AnyDACDriver_Glyphs.res}
unit uDAAnyDACDriver;
interface
uses
DB, Classes,
uROClasses,
uDAEngine, uDAInterfaces, uDAInterfacesEx, uDAUtils,
uDAOracleInterfaces, uDAMySQLInterfaces, uDAADOInterfaces, uDAIBInterfaces,
uADStanIntf, uADCompClient, uADPhysIntf
{$IFDEF AnyDAC_MONITOR}
,uADMoniBase, uADMoniCustom
{$ENDIF}
;
type
// TADRDBMSKind = (mkUnknown, mkOracle, mkMSSQL, mkMSAccess, mkMySQL, mkDB2, mkASA, mkADS, mkInterbase, mkOther);
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,
IDAConnectionModelling,
IDACanQueryDatabaseNames,
IDAFileBasedDatabase,
IDAUseGenerators,
IDACanQueryGeneratorsNames,
IDATestableObject)
private
FADConnection: TADConnection;
fDriverType: TDAAnyDACDriverType;
fNativeSupportPrefer: Boolean;
fMSSQLSchemaEnabled: Boolean;
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;
protected
// IInterface
function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
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);
// transaction support
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 DoGetQueryFields(const aSQL: string; aParamsIfNeeded: TDAParamCollection; out Fields: TDAFieldCollection); override;
// procedure DoGetViewFields(const aViewName: 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;
{ IDATestableObject }
// procedure Test; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
{ IDAConnection }
function GetSPSelectSyntax(AHasArguments: Boolean): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function GetQuoteChars: TDAQuoteCharArray; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
// function IdentifierIsQuoted(const iIdentifier: string): boolean; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
function IdentifierNeedsQuoting(const AIdentifier: string): boolean; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
// function QuoteIdentifierIfNeeded(const iIdentifier: string): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
// function QuoteIdentifier(const iIdentifier: string): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
// function QuoteFieldNameIfNeeded(const aTableName, aFieldName: string): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
// function QuoteFieldName(const aTableName, aFieldName: string): string; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
// function NewCommand(const Text: string; CommandType: TDASQLStatementType; const aCommandName: string = ''): IDASQLCommand; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
// function NewDataset(const SQL: string; const aDatasetName: string = ''): IDADataset; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
// function isAlive: Boolean; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
// function GetQueryBuilder: TDAQueryBuilder; 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 RefreshParams; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
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;
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;
procedure Register;
function GetDriverObject: IDADriver; stdcall;
function AnyDACDriverIdToAnyDACDriverType(Provider: string): TDAAnyDACDriverType;
implementation
uses
SysUtils, Variants, Math,
uDADriverManager, uDARes, uDAMacroProcessors, uDAHelpers, uROBinaryHelpers,
uADStanParam, uADStanConst, uADStanOption, uADStanFactory, uADGUIxConsoleWait,
uADPhysManager, uADPhysODBC, uADPhysOracl, uADPhysMySQL, uADPhysMSSQL,
uADPhysMSAcc, uADPhysDB2, uADPhysASA, uADPhysIB, uADPhysADS
{$IFDEF AnyDAC_D11}
, uADPhysTDBX
{$ELSE}
{$IFDEF AnyDAC_D6}
, uADPhysDbExp
{$ENDIF}
{$ENDIF}
, uADCompDataSet;
{$IFDEF DataAbstract_SchemaModelerOnly}
{$INCLUDE ..\DataAbstract_SchemaModelerOnly.inc}
{$ENDIF DataAbstract_SchemaModelerOnly}
{------------------------------------------------------------------------------}
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;
{------------------------------------------------------------------------------}
{ Generic procedures }
{------------------------------------------------------------------------------}
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;
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 := datCurrency;
dtBCD: Result := datCurrency;
dtFmtBCD: Result := datDecimal;
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',
[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
mkMySQL: Result := MYSQL_GetDefaultCustomParameters;
mkMSSQL: Result := 'Schemas=1;Integrated Security=SSPI;';
mkOracle: Result := S_AD_ConnParam_Common_OSAuthent+'=No;';
end;
{$IFDEF ANYDAC_DEBUGMODE}
Result := Result + 'NativeSupportPrefer=0;';
{$ENDIF ANYDAC_DEBUGMODE}
end;
{------------------------------------------------------------------------------}
function TDAEAnyDACDriver.GetDefaultConnectionType(
const AuxDriver: string): string;
begin
case AnyDACDriverIdToAnyDACDriverType(AuxDriver) of
// mkUnknown: Result := '';
mkOracle: Result := Oracle_DriverType;
mkMSSQL: Result := MSSQL_DriverType;
mkMSAccess: Result := Access_DriverType;
mkMySQL: Result := MySQL_DriverType;
mkDB2: Result := DB2_DriverType;
mkASA: Result := ASA_DriverType;
// mkADS: Result:='';
mkInterbase: Result := IB_DriverType;
else
Result := inherited GetDefaultConnectionType(AuxDriver);
end;
end;
{------------------------------------------------------------------------------}
procedure TDAEAnyDACDriver.GetAuxParams(const AuxDriver: string;
out List: IROStrings);
begin
inherited;
case AnyDACDriverIdToAnyDACDriverType(AuxDriver) of
mkOracle: List.Add(S_AD_ConnParam_Common_OSAuthent+'=<Yes,No>');
mkMSSQL: MSSQL_GetAuxParams(List);
mkInterBase: AddIBAuxParams(List);
mkMySQL: MYSQL_GetAuxParams(List);
end;
List.Add('ConnectionDefName=<string>');
List.Add('');
List.Add('You can pass any parameters directly to driver. Use the prefix ''@'' for this, e.g.:');
List.Add('Port=3306;@Pooled=True');
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
Params.Assign(AParsedParams);
Result := Format('__DACD_%d', [FConnectionDefIndex]);
Name := Result;
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, 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
result := TDAEAnyDACQuery;
end;
{------------------------------------------------------------------------------}
function TDAEAnyDACConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
begin
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
==
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;
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,'NativeSupportPrefer') then begin
fNativeSupportPrefer:= sValue = '1';
Continue;
end
else 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, '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 sName[1] = '@' then
sName := Pchar(sName) + 1;
oParams.Values[sName] := sValue;
end;
end;
FADConnection.ConnectionDefName :=
TDAEAnyDACDriver(Driver).LookupConnectionString(GetConnectionString, oParams);
finally
oParams.Free;
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
if fNativeSupportPrefer then
Result := Native_DoGetLastAutoInc(GeneratorName)
else case fDriverType of
mkMSSQL: Result := MSSQL_DoGetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
mkInterBase: Result := IB_GetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
mkMySQL: Result := MySQL_GetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
mkOracle: Result := Oracle_DoGetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
else
Result := Native_DoGetLastAutoInc(GeneratorName);
end;
end;
{------------------------------------------------------------------------------}
procedure TDAEAnyDACConnection.DoGetStoredProcedureNames(out List: IROStrings);
begin
inherited;
if fNativeSupportPrefer then
DoGetNames(List, dotProcedure)
else case fDriverType of
mkMSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure, fMSSQLSchemaEnabled);
mkInterbase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotProcedure);
mkMySQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure, FADConnection.ResultConnectionDef.Database);
mkOracle: Oracle_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure);
else
DoGetNames(List, dotProcedure);
end
end;
{------------------------------------------------------------------------------}
procedure TDAEAnyDACConnection.DoGetViewNames(out List: IROStrings);
begin
inherited;
if fNativeSupportPrefer then
DoGetNames(List, dotView)
else case fDriverType of
mkMSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotView, fMSSQLSchemaEnabled);
mkInterbase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotView);
mkMySQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotView, FADConnection.ResultConnectionDef.Database);
mkOracle: Oracle_DoGetNames(GetDatasetClass.Create(Self), List, dotView);
else
DoGetNames(List, dotView);
end
end;
{------------------------------------------------------------------------------}
procedure TDAEAnyDACConnection.DoGetTableNames(out List: IROStrings);
begin
inherited;
if fNativeSupportPrefer then
DoGetNames(List, dotTable)
else case fDriverType of
mkMSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotTable, fMSSQLSchemaEnabled);
mkInterbase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotTable);
mkMySQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotTable, FADConnection.ResultConnectionDef.Database);
mkOracle: Oracle_DoGetNames(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(Word(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
if fNativeSupportPrefer then
Native_DoGetTableFields(aTableName,Fields)
else case fDriverType of
mkMSSQL: MSSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
mkInterBase: IB_GetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
mkMySQL: MYSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName),GetDatasetClass.Create(Self),Fields, FADConnection.ResultConnectionDef.Database);
mkOracle: Oracle_DoGetTableFields(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);
else
inherited;
end;
end;
{------------------------------------------------------------------------------}
procedure TDAEAnyDACConnection.DoGetForeignKeys(
out ForeignKeys: TDADriverForeignKeyCollection);
begin
inherited;
if fNativeSupportPrefer then
Native_DoGetForeignKeys(ForeignKeys)
else case fDriverType of
mkMSSQL: MSSQL_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys, fMSSQLSchemaEnabled);
mkInterBase: IB_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys);
mkMySQL: MYSQL_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys, FADConnection.ResultConnectionDef.Database);
mkOracle: Oracle_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys);
else
Native_DoGetForeignKeys(ForeignKeys);
end;
end;
{------------------------------------------------------------------------------}
function TDAEAnyDACConnection.CreateMacroProcessor: TDASQLMacroProcessor;
begin
case fDriverType of
mkInterBase: Result := IB_CreateMacroProcessor;
mkMSSQL,mkMSAccess: Result := MSSQL_CreateMacroProcessor;
mkOracle: Result := Oracle_CreateMacroProcessor;
else
Result := inherited CreateMacroProcessor;
end;
end;
{------------------------------------------------------------------------------}
// IDAConnection
function TDAEAnyDACConnection.GetSPSelectSyntax(AHasArguments: Boolean): string;
begin
case fDriverType of
mkMSSQL: Result := MSSQL_GetSPSelectSyntax(AHasArguments);
mkInterBase: Result := IB_GetSPSelectSyntax(AHasArguments);
mkOracle: Result := Oracle_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
If fNativeSupportPrefer then
Result := Native_GetQuoteChars
else 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
mkMSSQL: Result := MSSQL_IdentifierNeedsQuoting(AIdentifier);
mkInterBase: Result := IB_IdentifierNeedsQuoting(AIdentifier, GetSQLDialect);
mkMySQL: Result := MYSQL_IdentifierNeedsQuoting(AIdentifier);
mkORACLE: Result := Oracle_IdentifierNeedsQuoting(AIdentifier);
else
end;
end;
{------------------------------------------------------------------------------}
// IDAADOConnection
function TDAEAnyDACConnection.GetCommandTimeout: Integer;
begin
raise exception.Create(err_NotSupported);
end;
{------------------------------------------------------------------------------}
function TDAEAnyDACConnection.GetProviderName: string;
begin
raise exception.Create(err_NotSupported);
end;
{------------------------------------------------------------------------------}
function TDAEAnyDACConnection.GetProviderType: TDAOleDBProviderType;
begin
raise exception.Create(err_NotSupported);
end;
{------------------------------------------------------------------------------}
procedure TDAEAnyDACConnection.SetCommandTimeout(const Value: Integer);
begin
raise exception.Create(err_NotSupported);
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;
(*
TDADataType = (datUnknown,
datString,
datDateTime,
datFloat,
datCurrency,
datAutoInc,
datInteger,
datLargeInt,
datBoolean,
datMemo,
datBlob,
datWideString,
datWideMemo,
datLargeAutoInc,
datByte,
datShortInt,
datWord,
datSmallInt,
datCardinal,
datLargeUInt,
datGuid,
datXml,
datDecimal,
datSingleFloat);
mkMSAccess:
case aField.DataType of
end;
mkDB2:
case aField.DataType of
end;
mkASA:
case aField.DataType of
end;
mkInterbase:
case aField.DataType of
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.SetupDataset(ADataSet: TADRdbmsDataSet);
begin
with TADQuery(ADataSet) do begin
Connection := FADConnection;
Unidirectional := True;
FetchOptions.Mode := fmAll;
FetchOptions.Items := FetchOptions.Items - [fiMeta];
FetchOptions.RowsetSize := 500;
ResourceOptions.SilentMode := True;
end;
end;
{------------------------------------------------------------------------------}
{ TDAEAnyDACQuery }
{------------------------------------------------------------------------------}
function TDAEAnyDACQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
begin
result := TADQuery.Create(nil);
TDAEAnyDACConnection(aConnection).SetupDataset(TADQuery(result));
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
TADQuery(Dataset).ExecSQL;
Result := TADQuery(Dataset).RowsAffected;
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;
{------------------------------------------------------------------------------}
procedure TDAEAnyDACQuery.RefreshParams;
begin
inherited;
end;
{------------------------------------------------------------------------------}
{ TDAEAnyDACStoredProcedure }
{------------------------------------------------------------------------------}
function TDAEAnyDACStoredProcedure.CreateDataset(AConnection: TDAEConnection): TDataset;
begin
Result := TADStoredProc.Create(nil);
TDAEAnyDACConnection(aConnection).SetupDataset(TADStoredProc(Result));
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.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;
{------------------------------------------------------------------------------}
{ 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;
function TDAEAnyDACStoredProcedure.DoExecute: integer;
begin
TADStoredProc(Dataset).ExecProc;
result := TADStoredProc(Dataset).RowsAffected;
end;
initialization
_driver := nil;
RegisterDriverProc(GetDriverObject);
finalization
UnregisterDriverProc(GetDriverObject);
FreeAndNil(_driver);
end.