david
2a98435b14
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@68 b6239004-a887-0f4b-9937-50029ccdca16
1197 lines
41 KiB
ObjectPascal
1197 lines
41 KiB
ObjectPascal
unit uDAUniDACDriver;
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Driver Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up, Kylix 3 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the Data Abstract }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
{$I ..\DataAbstract.inc}
|
|
{$ELSE}
|
|
{$I ../DataAbstract.inc}
|
|
{$ENDIF}
|
|
|
|
|
|
{.$DEFINE UNIDAC_NATIVE_ONLY}
|
|
interface
|
|
|
|
uses DB, Classes, uDAEngine, uROClasses,
|
|
uROBinaryHelpers, uDAUtils,
|
|
DBAccess, Uni, DASQLMonitor, UniSQLMonitor,
|
|
uDAInterfaces,
|
|
uDAADOInterfaces,
|
|
uDAIBInterfaces,
|
|
uDASQLiteInterfaces,
|
|
uDAOracleInterfaces,
|
|
uDAMySQLInterfaces,
|
|
uDADB2Interfaces,
|
|
uDASybaseInterfaces,
|
|
uDAPostgresInterfaces;
|
|
|
|
type
|
|
|
|
TDAUnidacDriverType = (
|
|
dauUnknown,
|
|
dauAccess,
|
|
dauAdvantage,
|
|
dauASE,
|
|
dauIBMDB2,
|
|
dauInterBase,
|
|
dauMySQL,
|
|
dauOracle,
|
|
dauPostgreSQL,
|
|
dauSQLite,
|
|
dauMSSQL);
|
|
|
|
const
|
|
uni_access = 'access';
|
|
uni_advantage = 'advantage';
|
|
uni_ase = 'ase';
|
|
uni_ibmdb2 = 'db2';
|
|
uni_interbase = 'interbase';
|
|
uni_mysql = 'mysql';
|
|
uni_oracle = 'oracle';
|
|
uni_postgresql = 'postgresql';
|
|
uni_sqlite = 'sqlite';
|
|
uni_sqlserver = 'sql server';
|
|
|
|
type
|
|
{ TDAUniDACDriver }
|
|
TDAUniDACDriver = class(TDADriverReference)
|
|
end;
|
|
|
|
{ TDAEUniDACDriver }
|
|
TDAEUniDACDriver = class(TDAEDriver,IDADriver40)
|
|
private
|
|
fMonitor: TUniSQLMonitor;
|
|
fTraceCallBack: TDALogTraceEvent;
|
|
procedure OnSDACTrace(Sender: TObject; Text: string; Flag: TDATraceFlag);
|
|
protected
|
|
function GetConnectionClass: TDAEConnectionClass; override;
|
|
procedure DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent); override;
|
|
// IDADriver
|
|
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 GetAvailableDriverOptionsEx(AuxDriver: string): 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;
|
|
|
|
{ TDAEMyConnection }
|
|
TDAEUniDACConnection = class(TDAEConnection, IDAConnection,
|
|
IDAInterbaseConnection, //IDAIBTransactionAccess, IDAIBConnectionProperties,
|
|
IDAOracleConnection,
|
|
IDAMySQLConnection,
|
|
IDASQLiteConnection,
|
|
IDADB2Connection,
|
|
IDASybaseConnection,
|
|
IDAPostgresConnection,
|
|
// IDAConnectionModelling,
|
|
IDACanQueryDatabaseNames,
|
|
IDAFileBasedDatabase,
|
|
// IDADirectoryBasedDatabase,
|
|
IDAUseGenerators,
|
|
IDAUseGenerators2,
|
|
IDACanQueryGeneratorsNames,
|
|
IDATestableObject)
|
|
private
|
|
fConnection: TUniConnection;
|
|
fDriverName: string;
|
|
fDriverType: TDAUnidacDriverType;
|
|
fMSSQLSchemaEnabled: Boolean;
|
|
FMySQLVersion: integer;
|
|
FSchemaSupported: integer;
|
|
function CombineSchemaWithName(aSchema, aName: string): string;
|
|
function GetMySQLVersion: integer;
|
|
procedure native_DoGetNames(AList: IROStrings; AObjectType: TDAObjecttype);
|
|
procedure native_DoGetForeignKeys(ForeignKeys: TDADriverForeignKeyCollection);
|
|
procedure native_GetGeneratorNames(AList: IROStrings);
|
|
procedure native_DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection);
|
|
function isSchemaSupported: Boolean;
|
|
protected
|
|
function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
|
|
function CreateCustomConnection: TCustomConnection; override;
|
|
|
|
function GetDatasetClass: TDAEDatasetClass; override;
|
|
function GetStoredProcedureClass: TDAEStoredProcedureClass; override;
|
|
|
|
procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser;
|
|
aConnectionObject: TCustomConnection); override;
|
|
|
|
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;
|
|
//rocedure 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 DoGetLastAutoIncValue(const GeneratorName: string): Variant; override;
|
|
|
|
{ IDATestableObject }
|
|
// procedure Test; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
|
|
{ IDAConnection }
|
|
|
|
function GetSPSelectSyntax(HasArguments: 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 iIdentifier: 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}
|
|
|
|
{ IDAInterbaseConnection }
|
|
// nothing
|
|
|
|
{ IDAIBTransactionAccess }
|
|
//function GetTransaction: TObject; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
//procedure CommitRetaining; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
//procedure RollbackRetaining; {$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}
|
|
{ IDAUseGenerators2 }
|
|
function GetNextAutoinc2(const GeneratorName: string): variant; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
|
|
{ IDACanQueryGeneratorsNames }
|
|
function GetGeneratorNames: IROStrings;
|
|
public
|
|
end;
|
|
|
|
{ TDAEUniDACQuery }
|
|
TDAEUniDACQuery = class(TDAEDataset,IDAMustSetParams)
|
|
private
|
|
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
procedure ClearParams; override;
|
|
function DoExecute: integer; override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function DoGetSQL: string; override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure DoSetSQL(const Value: string); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure DoPrepare(Value: boolean); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure SetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
|
|
public
|
|
end;
|
|
|
|
{ TDAEUniDACStoredProcedure }
|
|
TDAEUniDACStoredProcedure = class(TDAEStoredProcedure,IDAMustSetParams)
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
|
|
function GetStoredProcedureName: string; override;
|
|
procedure SetStoredProcedureName(const Name: string); override;
|
|
function DoExecute: integer; override;
|
|
function Execute: integer; override;
|
|
procedure RefreshParams; 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;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF FPC}LResources,{$ENDIF}
|
|
{$IFDEF MSWINDOWS}Windows, {$ENDIF}
|
|
SysUtils, Variants,
|
|
uDADriverManager, uDARes, TypInfo,
|
|
{$IFDEF MSWINDOWS}
|
|
AccessUniProvider,
|
|
AdvantageUniProvider,
|
|
ASEUniProvider,
|
|
DB2UniProvider,
|
|
ODBCUniProvider,
|
|
SQLServerUniProvider,
|
|
{$ENDIF}
|
|
InterBaseUniProvider,
|
|
MySQLUniProvider,
|
|
OracleUniProvider,
|
|
PostgreSQLUniProvider,
|
|
SQLiteUniProvider,
|
|
UniProvider;
|
|
|
|
{$IFNDEF FPC}
|
|
{$R DataAbstract_UniDACDriver_Glyphs.res}
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
function UNIDriverIdToUNIDriverType(aAuxDriver: string): TDAUnidacDriverType;
|
|
begin
|
|
Result := dauUnknown;
|
|
aAuxDriver := LowerCase(aAuxDriver);
|
|
if uni_access = aAuxDriver then Result := dauAccess
|
|
else if uni_advantage = aAuxDriver then Result := dauAdvantage
|
|
else if uni_ase = aAuxDriver then Result := dauASE
|
|
else if uni_ibmdb2 = aAuxDriver then Result := dauIBMDB2
|
|
else if uni_interbase = aAuxDriver then Result := dauInterBase
|
|
else if uni_MySQL = aAuxDriver then Result := dauMySQL
|
|
else if uni_ORACLE = aAuxDriver then Result := dauOracle
|
|
else if uni_PostgreSQL = aAuxDriver then Result := dauPostgreSQL
|
|
else if uni_SQLite = aAuxDriver then Result := dauSQLite
|
|
else if uni_sqlserver = aAuxDriver then Result := dauMSSQL
|
|
else ;
|
|
end;
|
|
|
|
|
|
var
|
|
_driver: TDAEDriver = nil;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DAPalettePageName, [TDAUniDACDriver]);
|
|
end;
|
|
|
|
{$IFDEF DataAbstract_SchemaModelerOnly}
|
|
{$INCLUDE ..\DataAbstract_SchemaModelerOnly.inc}
|
|
{$ENDIF DataAbstract_SchemaModelerOnly}
|
|
|
|
function GetDriverObject: IDADriver;
|
|
begin
|
|
{$IFDEF DataAbstract_SchemaModelerOnly}
|
|
if not RunningInSchemaModeler then begin
|
|
result := nil;
|
|
exit;
|
|
end;
|
|
{$ENDIF}
|
|
if (_driver = nil) then _driver := TDAEUniDACDriver.Create(nil);
|
|
result := _driver;
|
|
end;
|
|
|
|
{$I uDACRLabsUtils.inc}
|
|
|
|
{ TDAEUniDACDriver }
|
|
|
|
procedure TDAEUniDACDriver.DoSetTraceOptions(TraceActive: boolean;
|
|
TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent);
|
|
var
|
|
sdacopts: TDATraceFlags;
|
|
begin
|
|
inherited;
|
|
if TraceActive then begin
|
|
if (fMonitor = nil) then fMonitor := TUniSQLMonitor.Create(Self);
|
|
|
|
fMonitor.Active := FALSE;
|
|
fMonitor.OnSQL := OnSDACTrace;
|
|
|
|
sdacopts := [];
|
|
if (toPrepare in TraceOptions) then sdacopts := sdacopts + [tfQPrepare];
|
|
if (toExecute in TraceOptions) then sdacopts := sdacopts + [tfQExecute];
|
|
if (toFetch in TraceOptions) then sdacopts := sdacopts + [tfQFetch];
|
|
if (toError in TraceOptions) then sdacopts := sdacopts + [tfError];
|
|
if (toStmt in TraceOptions) then sdacopts := sdacopts + [tfStmt];
|
|
if (toConnect in TraceOptions) then sdacopts := sdacopts + [tfConnect];
|
|
if (toTransact in TraceOptions) then sdacopts := sdacopts + [tfTransact];
|
|
if (toBlob in TraceOptions) then sdacopts := sdacopts + [tfBlob];
|
|
if (toService in TraceOptions) then sdacopts := sdacopts + [tfService];
|
|
if (toMisc in TraceOptions) then sdacopts := sdacopts + [tfMisc];
|
|
if (toParams in TraceOptions) then sdacopts := sdacopts + [tfParams];
|
|
|
|
fTraceCallBack := Callback;
|
|
|
|
fMonitor.TraceFlags := sdacopts;
|
|
fMonitor.Active := TRUE;
|
|
end
|
|
else begin
|
|
FreeAndNIL(fMonitor);
|
|
fTraceCallback := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEUniDACDriver.GetAuxDrivers(out List: IROStrings);
|
|
var
|
|
i : integer;
|
|
str: TStringList;
|
|
begin
|
|
inherited;
|
|
Str := TStringList.Create;
|
|
try
|
|
UniProviders.GetProviderNames(str);
|
|
for i := 0 to Str.Count - 1 do
|
|
if UNIDriverIdToUNIDriverType(str[i]) <> dauUnknown then
|
|
List.Add(str[i]);
|
|
List.Sorted := True;
|
|
finally
|
|
Str.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEUniDACDriver.GetAuxParams(const AuxDriver: string;
|
|
out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
case UNIDriverIdToUNIDriverType(AuxDriver) of
|
|
dauMSSQL: MSSQL_GetAuxParams(List);
|
|
end;
|
|
List.Add('Options.<Param>=<Value>');
|
|
List.Add('SpecificOptions.<Param>=<Value>');
|
|
case UNIDriverIdToUNIDriverType(AuxDriver) of
|
|
dauAccess, dauSQLite:;
|
|
else
|
|
List.Add('Port=<integer>');
|
|
end;
|
|
List.Add('');
|
|
List.Add('Consult to UniDAC documentation about Options and SpecificOptions options.');
|
|
end;
|
|
|
|
function TDAEUniDACDriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
|
|
begin
|
|
Result := [doAuxDriver, doServerName, doDatabaseName, doLogin, doCustom];
|
|
end;
|
|
|
|
function TDAEUniDACDriver.GetAvailableDriverOptionsEx(
|
|
AuxDriver: string): TDAAvailableDriverOptions;
|
|
begin
|
|
case UNIDriverIdToUNIDriverType(AuxDriver) of
|
|
dauAccess : Result := [doAuxDriver, doDatabaseName, doLogin, doCustom];
|
|
dauSQLite : Result := [doAuxDriver, doDatabaseName, doCustom];
|
|
else
|
|
Result := [doAuxDriver, doServerName, doDatabaseName, doLogin, doCustom];
|
|
end;
|
|
end;
|
|
|
|
function TDAEUniDACDriver.GetConnectionClass: TDAEConnectionClass;
|
|
begin
|
|
result := TDAEUniDACConnection;
|
|
end;
|
|
|
|
function TDAEUniDACDriver.GetDefaultConnectionType(
|
|
const AuxDriver: string): string;
|
|
begin
|
|
case UNIDriverIdToUNIDriverType(AuxDriver) of
|
|
dauAccess: Result := Access_DriverType;
|
|
// dauAdvantage,
|
|
// dauASE,
|
|
dauIBMDB2: Result:= DB2_DriverType;
|
|
dauInterBase: Result := IB_DriverType;
|
|
dauMySQL: Result := MySQL_DriverType;
|
|
dauOracle: Result := Oracle_DriverType;
|
|
dauPostgreSQL: Result := PostgreSQL_DriverType;
|
|
dauSQLite: Result:= SQLite_DriverType;
|
|
dauMSSQL: Result := MSSQL_DriverType;
|
|
else
|
|
Result:= inherited GetDefaultConnectionType(AuxDriver);
|
|
end;
|
|
end;
|
|
|
|
function TDAEUniDACDriver.GetDescription: string;
|
|
begin
|
|
result := 'Devart''s UniDAC'{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF};
|
|
end;
|
|
|
|
function TDAEUniDACDriver.GetDriverID: string;
|
|
begin
|
|
Result := 'UniDAC';
|
|
end;
|
|
|
|
function TDAEUniDACDriver.GetProviderDefaultCustomParameters(
|
|
Provider: string): string;
|
|
begin
|
|
Result := '';
|
|
case UNIDriverIdToUNIDriverType(Provider) of
|
|
dauMySQL: Result := MYSQL_GetDefaultCustomParameters;
|
|
dauMSSQL: Result := 'Schemas=1;Integrated Security=SSPI';
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEUniDACDriver.OnSDACTrace(Sender: TObject; Text: string;
|
|
Flag: TDATraceFlag);
|
|
begin
|
|
if Assigned(fTraceCallback) then fTraceCallback(Sender, Text, integer(Flag));
|
|
end;
|
|
|
|
{ TDAEUniDACConnection }
|
|
|
|
function TDAEUniDACConnection.CombineSchemaWithName(aSchema,
|
|
aName: string): string;
|
|
begin
|
|
if not isSchemaSupported then begin
|
|
Result := aName
|
|
end
|
|
else begin
|
|
if (fDriverType = dauMSSQL) and (not fMSSQLSchemaEnabled) then begin
|
|
if aSchema = 'dbo' then
|
|
Result := aName
|
|
else
|
|
Result := aSchema + '.' + aName;
|
|
end
|
|
else
|
|
Result := aSchema + '.' + aName;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.Commit;
|
|
begin
|
|
Self.DoCommitTransaction;
|
|
end;
|
|
|
|
function TDAEUniDACConnection.CreateCustomConnection: TCustomConnection;
|
|
begin
|
|
fConnection := TUniConnection.Create(nil);
|
|
fConnection.LoginPrompt := FALSE;
|
|
|
|
result := fConnection;
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.DoApplyConnectionString(
|
|
aConnStrParser: TDAConnectionStringParser;
|
|
aConnectionObject: TCustomConnection);
|
|
var
|
|
i: integer;
|
|
sName, lcName, sValue: string;
|
|
begin
|
|
FSchemaSupported := -1;
|
|
FMySQLVersion := -1;
|
|
fMSSQLSchemaEnabled := True;
|
|
inherited;
|
|
with aConnStrParser do begin
|
|
fDriverName := AuxDriver;
|
|
fDriverType := UNIDriverIdToUNIDriverType(AuxDriver);
|
|
|
|
fConnection.ProviderName := AuxDriver;
|
|
if (Self.UserID <> '') then
|
|
fConnection.Username := Self.UserID
|
|
else
|
|
fConnection.Username := UserID;
|
|
|
|
if (Self.Password <> '') then
|
|
fConnection.Password := Self.Password
|
|
else
|
|
fConnection.Password := Password;
|
|
if Server <> '' then fConnection.Server := Server;
|
|
if Database <> '' then fConnection.Database := Database;
|
|
|
|
for i := 0 to AuxParamsCount - 1 do begin
|
|
sName := AuxParamNames[i];
|
|
if sName = '' then Continue;
|
|
lcName := AnsiLowerCase(sName);
|
|
sValue := AuxParams[AuxParamNames[i]];
|
|
if AnsiSameText(sName, 'port') then begin
|
|
if StrToIntDef(sValue, -1) <> -1 then fConnection.Port := StrToInt(sValue);
|
|
end
|
|
else if Pos('options.', lcName) = 1 then begin
|
|
sName := Copy(sName,9, Length(sName)-8);
|
|
SetPropValue(fConnection.Options, sName, sValue);
|
|
end
|
|
else if Pos('specificoptions.', lcName) = 1 then begin
|
|
sName := Copy(sName,17, Length(sName)- 16);
|
|
fConnection.SpecificOptions.Values[sValue]:=sName;
|
|
end
|
|
else if lcName = 'schemas' then begin
|
|
fMSSQLSchemaEnabled := AuxParams['Schemas'] = '1'
|
|
end
|
|
else if (fDriverType = dauMSSQL) and (lcname = 'integrated security') and (AnsiSameText(sValue, 'SSPI')) then begin
|
|
fConnection.SpecificOptions.Values['Authentication']:='auWindows';
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDAEUniDACConnection.DoBeginTransaction: integer;
|
|
begin
|
|
fConnection.StartTransaction;
|
|
result := 0;
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.DoCommitTransaction;
|
|
begin
|
|
fConnection.Commit;
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.DoGetForeignKeys(
|
|
out ForeignKeys: TDADriverForeignKeyCollection);
|
|
begin
|
|
inherited;
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauMSSQL: MSSQL_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys, fMSSQLSchemaEnabled);
|
|
dauInterBase: IB_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys);
|
|
dauMySQL: MYSQL_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys, fConnection.Database,GetMySQLVersion);
|
|
dauPostgreSQL: Postgres_DoGetForeignKeys(GetDatasetClass.Create(Self),ForeignKeys);
|
|
dauOracle: Oracle_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys);
|
|
dauSQLite: SQLite_DoGetForeignKeys(GetDatasetClass.Create(Self),ForeignKeys);
|
|
else
|
|
{$ENDIF}
|
|
native_DoGetForeignKeys(ForeignKeys);
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDAEUniDACConnection.DoGetInTransaction: boolean;
|
|
begin
|
|
Result := fConnection.InTransaction;
|
|
end;
|
|
|
|
function TDAEUniDACConnection.DoGetLastAutoIncValue(
|
|
const GeneratorName: string): Variant;
|
|
begin
|
|
Result := -1;
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauMSSQL: Result := MSSQL_DoGetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
dauInterBase: Result := IB_GetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
dauMySQL: Result := MySQL_GetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
dauOracle: Result := Oracle_DoGetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
dauPostgreSQL: Result := Postgres_DoGetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
else
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.native_DoGetForeignKeys(
|
|
ForeignKeys: TDADriverForeignKeyCollection);
|
|
begin
|
|
// not implemented yet
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.native_DoGetNames(AList: IROStrings;
|
|
AObjectType: TDAObjecttype);
|
|
|
|
procedure _GetNames(aRestriction: string);
|
|
var
|
|
FMetadata: TUniMetaData;
|
|
fld, fld2: TField;
|
|
begin
|
|
FMetadata := TUniMetaData(fConnection.CreateMetaData);
|
|
try
|
|
FMetadata.MetaDataKind := 'tables';
|
|
if (fDriverType = dauMSSQL) and not fMSSQLSchemaEnabled then
|
|
FMetadata.Restrictions.Values['TABLE_SCHEMA'] := 'dbo';
|
|
FMetadata.Restrictions.Values['TABLE_TYPE'] := aRestriction;
|
|
FMetadata.Open;
|
|
fld := FMetadata.FindField('TABLE_SCHEMA');
|
|
fld2 := FMetadata.FieldByName('TABLE_NAME');
|
|
while not FMetadata.Eof do begin
|
|
if isSchemaSupported and (fld <> nil) and (fld.AsString <> '') then
|
|
AList.Add(CombineSchemaWithName(fld.AsString,fld2.AsString))
|
|
else
|
|
AList.Add(fld2.AsString);
|
|
FMetadata.Next;
|
|
end;
|
|
finally
|
|
FMetadata.Free;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
case AObjectType of
|
|
dotTable: _GetNames('TABLE');
|
|
dotView: _GetNames('VIEW');
|
|
dotProcedure: fConnection.GetStoredProcNames(AList.Strings);
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.native_DoGetTableFields(const aTableName: string;
|
|
out Fields: TDAFieldCollection);
|
|
var
|
|
FMetadata: TUniMetaData;
|
|
i: integer;
|
|
lSchemaName,lTableName: string;
|
|
lPK: string;
|
|
fld: TDAField;
|
|
begin
|
|
inherited DoGetTableFields(aTableName,Fields);
|
|
|
|
FMetadata := TUniMetaData(fConnection.CreateMetaData);
|
|
try
|
|
FMetadata.MetaDataKind := 'constraints';
|
|
i := pos('.', aTableName);
|
|
if isSchemaSupported and (i <> 0) then begin
|
|
lSchemaName := Copy(aTableName, 1, i-1);
|
|
lTableName := Copy(aTableName, i+1, Length(aTableName)-i);
|
|
end
|
|
else begin
|
|
lSchemaName := '';
|
|
lTableName := aTableName;
|
|
end;
|
|
|
|
if (fDriverType = dauMSSQL) and not fMSSQLSchemaEnabled then
|
|
FMetadata.Restrictions.Values['TABLE_SCHEMA'] := 'dbo'
|
|
else
|
|
if lSchemaName <> '' then
|
|
FMetadata.Restrictions.Values['TABLE_SCHEMA'] := lSchemaName;
|
|
FMetadata.Restrictions.Values['TABLE_NAME'] := lTableName;
|
|
FMetadata.Restrictions.Values['CONSTRAINT_TYPE'] := 'PRIMARY KEY';
|
|
FMetadata.Open;
|
|
if not FMetadata.Eof then lPk := FMetadata.FieldByName('CONSTRAINT_NAME').AsString;
|
|
if lpk <> '' then begin
|
|
FMetadata.Close;
|
|
FMetadata.MetaDataKind := 'IndexColumns';
|
|
FMetadata.Restrictions.Values['INDEX_NAME'] := lPK;
|
|
FMetadata.Open;
|
|
While not FMetadata.Eof do begin
|
|
fld:= Fields.FindField(FMetadata.FieldByName('COLUMN_NAME').AsString);
|
|
if fld <> nil then begin
|
|
fld.InPrimaryKey := True;
|
|
fld.Required := True;
|
|
end;
|
|
FMetadata.Next;
|
|
end;
|
|
end;
|
|
finally
|
|
FMetadata.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.native_GetGeneratorNames(AList: IROStrings);
|
|
var
|
|
FMetadata: TUniMetaData;
|
|
s: string;
|
|
begin
|
|
// nowadays, IB is only supported
|
|
FMetadata := TUniMetaData(fConnection.CreateMetaData);
|
|
try
|
|
FMetadata.MetaDataKind := 'generators';
|
|
FMetadata.Open;
|
|
while not FMetadata.Eof do begin
|
|
s:= FMetadata.Fields[0].AsString;
|
|
AList.Add(s);
|
|
FMetadata.Next;
|
|
end;
|
|
finally
|
|
FMetadata.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.DoGetStoredProcedureNames(out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauMSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure, fMSSQLSchemaEnabled);
|
|
dauInterBase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotProcedure);
|
|
dauMYSQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure, fConnection.Database,GetMySQLVersion);
|
|
dauSQLite: SQLite_GetObjectNames(GetDatasetClass.Create(Self), List, dotProcedure);
|
|
dauPostgreSQL: Postgres_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure);
|
|
dauOracle: Oracle_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure);
|
|
else
|
|
{$ENDIF}
|
|
native_DoGetNames(List, dotProcedure);
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.DoGetStoredProcedureParams(
|
|
const aStoredProcedureName: string; out Params: TDAParamCollection);
|
|
begin
|
|
inherited DoGetStoredProcedureParams(aStoredProcedureName,Params);
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauMySQL: MYSQL_DoGetStoredProcedureParams(aStoredProcedureName, GetDatasetClass.Create(Self), Params, fConnection.Database);
|
|
dauOracle: Oracle_DoGetStoredProcedureParams(aStoredProcedureName, GetDatasetClass.Create(Self), Params);
|
|
dauPostgreSQL: Postgres_DoGetStoredProcedureParams(aStoredProcedureName, GetDatasetClass.Create(Self), Params);
|
|
dauMSSQL: MSSQL_DoGetStoredProcedureParams(aStoredProcedureName, GetDatasetClass.Create(Self), Params);
|
|
else
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.DoGetTableFields(const aTableName: string;
|
|
out Fields: TDAFieldCollection);
|
|
begin
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauMSSQL: MSSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
|
|
dauInterBase: IB_GetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
|
|
dauMySQL: MYSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName),GetDatasetClass.Create(Self),Fields, fConnection.Database,GetMySQLVersion);
|
|
dauOracle: Oracle_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
|
|
dauPostgreSQL: Postgres_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
|
|
else
|
|
{$ENDIF}
|
|
native_DoGetTableFields(aTableName, Fields);
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.DoGetTableNames(out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauMSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotTable, fMSSQLSchemaEnabled);
|
|
dauInterBase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotTable);
|
|
dauMYSQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotTable, fConnection.Database,GetMySQLVersion);
|
|
dauSQLite: SQLite_GetObjectNames(GetDatasetClass.Create(Self), List, dotTable);
|
|
dauPostgreSQL: Postgres_DoGetNames(GetDatasetClass.Create(Self), List, dotTable);
|
|
dauOracle: Oracle_DoGetNames(GetDatasetClass.Create(Self), List, dotTable);
|
|
else
|
|
{$ENDIF}
|
|
native_DoGetNames(List, dotTable);
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.DoGetViewNames(out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauMSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotView, fMSSQLSchemaEnabled);
|
|
dauInterBase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotView);
|
|
dauMYSQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotView, fConnection.Database,GetMySQLVersion);
|
|
dauSQLite: SQLite_GetObjectNames(GetDatasetClass.Create(Self), List, dotView);
|
|
dauPostgreSQL: Postgres_DoGetNames(GetDatasetClass.Create(Self), List, dotView);
|
|
dauOracle: Oracle_DoGetNames(GetDatasetClass.Create(Self), List, dotView);
|
|
else
|
|
{$ENDIF}
|
|
native_DoGetNames(List, dotView);
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.DoRollbackTransaction;
|
|
begin
|
|
fConnection.Rollback;
|
|
end;
|
|
|
|
|
|
function TDAEUniDACConnection.GetCharset: string;
|
|
begin
|
|
Result := fConnection.SpecificOptions.Values['Charset'];
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetDatabaseNames: IROStrings;
|
|
begin
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauMSSQL: Result := MSSQL_GetDatabaseNames(Self);
|
|
dauMySQL: Result := MYSQL_GetDatabaseNames(Self);
|
|
dauPostgreSQL: Result := Postgres_GetDatabaseNames(Self);
|
|
else
|
|
{$ENDIF}
|
|
Result := NewROStrings;
|
|
fConnection.GetDatabaseNames(Result.Strings);
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
Result := TDAEUniDACQuery;
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetFileExtensions: IROStrings;
|
|
begin
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauInterBase: Result := IB_GetFileExtensions;
|
|
dauSQLite: Result := SQLite_GetFileExtensions;
|
|
dauAccess: Result := MSACCESS_GetFileExtensions;
|
|
else
|
|
{$ENDIF}
|
|
Result := NewROStrings;
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetGeneratorNames: IROStrings;
|
|
begin
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauInterBase: Result:= IB_GetGeneratorNames(GetDatasetClass.Create(Self));
|
|
else
|
|
{$ENDIF}
|
|
Result := NewROStrings;
|
|
native_GetGeneratorNames(Result);
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetMySQLVersion: integer;
|
|
begin
|
|
if FMySQLVersion = -1 then FMySQLVersion := MYSQL_GetVersion(GetDatasetClass.Create(Self));
|
|
Result := FMySQLVersion;
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetNextAutoinc(
|
|
const GeneratorName: string): integer;
|
|
begin
|
|
Result := GetNextAutoinc2(GeneratorName);
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetNextAutoinc2(
|
|
const GeneratorName: string): variant;
|
|
begin
|
|
Result := -1;
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauInterBase: Result := IB_GetNextAutoinc(GeneratorName, GetDatasetClass.Create(Self));
|
|
dauOracle: Result := Oracle_GetNextAutoinc(GeneratorName, GetDatasetClass.Create(Self));
|
|
dauPostgreSQL: Result := Postgres_GetNextAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetQuoteChars: TDAQuoteCharArray;
|
|
begin
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauMSSQL: Result := MSSQL_GetQuoteChars;
|
|
dauOracle: Result:= Oracle_GetQuoteChars;
|
|
else
|
|
{$ENDIF}
|
|
Result := inherited GetQuoteChars;
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetRole: string;
|
|
begin
|
|
Result := fConnection.SpecificOptions.Values['Role'];
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetSPSelectSyntax(HasArguments: Boolean): string;
|
|
begin
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
case fDriverType of
|
|
dauMSSQL: Result := MSSQL_GetSPSelectSyntax(HasArguments);
|
|
dauInterBase: Result := IB_GetSPSelectSyntax(HasArguments);
|
|
dauOracle: Result := Oracle_GetSPSelectSyntax(HasArguments);
|
|
dauPostgreSQL: Result := Postgres_GetSPSelectSyntax(HasArguments);
|
|
else
|
|
{$ENDIF}
|
|
Result := inherited GetSPSelectSyntax(HasArguments);
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetSQLDialect: integer;
|
|
begin
|
|
Result := StrToIntDef(fConnection.SpecificOptions.Values['SQLDialect'],3);
|
|
end;
|
|
|
|
function TDAEUniDACConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
Result := TDAEUniDACStoredProcedure;
|
|
end;
|
|
|
|
function TDAEUniDACConnection.IdentifierNeedsQuoting(
|
|
const iIdentifier: string): boolean;
|
|
begin
|
|
Result:= inherited IdentifierNeedsQuoting(iIdentifier);
|
|
{$IFNDEF UNIDAC_NATIVE_ONLY}
|
|
if not result then
|
|
case fDriverType of
|
|
dauMSSQL: Result := MSSQL_IdentifierNeedsQuoting(iIdentifier);
|
|
dauInterBase: Result := IB_IdentifierNeedsQuoting(iIdentifier, GetSQLDialect);
|
|
dauMySQL: Result := MYSQL_IdentifierNeedsQuoting(iIdentifier);
|
|
dauORACLE: Result := Oracle_IdentifierNeedsQuoting(iIdentifier);
|
|
dauPostgreSQL: Result:= Postgres_IdentifierNeedsQuoting(iIdentifier);
|
|
dauIBMDB2: Result := DB2_IdentifierNeedsQuoting(iIdentifier);
|
|
dauASE,dauAdvantage: Result := Sybase_IdentifierNeedsQuoting(iIdentifier);
|
|
else
|
|
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDAEUniDACConnection.isSchemaSupported: Boolean;
|
|
var
|
|
Fld: TField;
|
|
begin
|
|
if FSchemaSupported = -1 then begin
|
|
With fConnection.CreateMetaData do try
|
|
MetaDataKind := 'tables';
|
|
Restrictions.Values['TABLE_NAME']:='___';
|
|
Open;
|
|
Fld := FindField('TABLE_SCHEMA');
|
|
Result := Assigned(Fld) and (Fld.Size <> 0);
|
|
FSchemaSupported := ord(Result);
|
|
finally
|
|
Free;
|
|
end;
|
|
end
|
|
else
|
|
Result := FSchemaSupported = 1;
|
|
end;
|
|
|
|
function TDAEUniDACConnection.QueryInterface(const IID: TGUID;
|
|
out Obj): HResult;
|
|
begin
|
|
Result := E_NOINTERFACE;
|
|
if IsEqualGUID(IID, IDAInterbaseConnection) then begin
|
|
if fDriverType <> dauInterbase then Exit;
|
|
end else if IsEqualGUID(IID, IDAIBTransactionAccess) then begin
|
|
if fDriverType <> dauInterbase then Exit;
|
|
end else if IsEqualGUID(IID, IDAIBConnectionProperties) then begin
|
|
if fDriverType <> dauInterbase then Exit;
|
|
end else if IsEqualGUID(IID, IDAOracleConnection) then begin
|
|
if fDriverType <> dauOracle then Exit;
|
|
end else if IsEqualGUID(IID, IDASQLiteConnection) then begin
|
|
if fDriverType <> dauSQLite then Exit;
|
|
end else if IsEqualGUID(IID, IDADB2Connection) then begin
|
|
if fDriverType <> dauIBMDB2 then Exit;
|
|
end else if IsEqualGUID(IID, IDASybaseConnection) then begin
|
|
if not (fDriverType in [dauAdvantage, dauASE]) then Exit;
|
|
end else if IsEqualGUID(IID, IDAPostgresConnection) then begin
|
|
if fDriverType <> dauPostgreSQL then Exit;
|
|
end else if IsEqualGUID(IID, IDAMySQLConnection) then begin
|
|
if fDriverType <> dauMySQL then Exit;
|
|
end else if IsEqualGUID(IID, IDACanQueryDatabaseNames) then begin
|
|
if (fDriverType in [dauInterBase, dauSQLite, dauAccess]) then Exit;
|
|
end else if IsEqualGUID(IID, IDAFileBasedDatabase) then begin
|
|
if not (fDriverType in [dauInterBase, dauSQLite, dauAccess]) then Exit;
|
|
end else if IsEqualGUID(IID, IDAUseGenerators) or IsEqualGUID(IID, IDAUseGenerators2) then begin
|
|
if not (fDriverType in [dauInterBase, dauOracle, dauPostgreSQL]) then Exit;
|
|
end else if IsEqualGUID(IID, IDACanQueryGeneratorsNames) then begin
|
|
if not (fDriverType in [dauInterBase]) then Exit;
|
|
end
|
|
|
|
// else if IsEqualGUID(IID, IDAConnectionModelling) then
|
|
// else if IsEqualGUID(IID, IDADirectoryBasedDatabase) then
|
|
;
|
|
Result := inherited QueryInterface(IID, Obj);
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.Rollback;
|
|
begin
|
|
Self.DoRollbackTransaction;
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.SetCharset(const Value: string);
|
|
begin
|
|
fConnection.SpecificOptions.Values['Charset'] := Value;
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.SetRole(const Value: string);
|
|
begin
|
|
fConnection.SpecificOptions.Values['Role'] := Value;
|
|
end;
|
|
|
|
procedure TDAEUniDACConnection.SetSQLDialect(Value: integer);
|
|
begin
|
|
fConnection.SpecificOptions.Values['SQLDialect'] := IntToStr(Value);
|
|
end;
|
|
|
|
{ TDAEUniDACQuery }
|
|
|
|
procedure TDAEUniDACQuery.ClearParams;
|
|
begin
|
|
inherited;
|
|
TUniQuery(Dataset).Params.Clear;
|
|
end;
|
|
|
|
function TDAEUniDACQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TUniQuery.Create(nil);
|
|
TUniQuery(result).Unidirectional := True;
|
|
TUniQuery(result).ReadOnly := TRUE;
|
|
TUniQuery(result).Connection := TDAEUniDACConnection(aConnection).fConnection;
|
|
end;
|
|
|
|
function TDAEUniDACQuery.DoExecute: integer;
|
|
begin
|
|
TUniQuery(Dataset).Execute;
|
|
result := TUniQuery(Dataset).RowsAffected;
|
|
end;
|
|
|
|
function TDAEUniDACQuery.DoGetSQL: string;
|
|
begin
|
|
result := TUniQuery(Dataset).SQL.Text;
|
|
end;
|
|
|
|
procedure TDAEUniDACQuery.DoPrepare(Value: boolean);
|
|
var
|
|
i: integer;
|
|
par: TUniParam;
|
|
begin
|
|
if Value and not TUniQuery(Dataset).Prepared and (TUniQuery(Dataset).ParamCount<>0) then begin
|
|
for I := 0 to GetParams.Count - 1 do begin
|
|
par:=TUniQuery(Dataset).ParamByName(GetParams[i].Name);
|
|
par.DataType:= DATypeToVCLType(GetParams[i].DataType);
|
|
if par.DataType = ftAutoInc then par.DataType:= ftInteger;
|
|
end;
|
|
end;
|
|
TUniQuery(Dataset).Prepared := Value;
|
|
end;
|
|
|
|
procedure TDAEUniDACQuery.DoSetSQL(const Value: string);
|
|
begin
|
|
TUniQuery(Dataset).SQL.Text := Value;
|
|
end;
|
|
|
|
procedure TDAEUniDACQuery.GetParamValues(AParams: TDAParamCollection);
|
|
var
|
|
I: Integer;
|
|
lParam: TUniParam;
|
|
begin
|
|
for i := 0 to TUniQuery(DataSet).Params.Count - 1 do begin
|
|
lParam:=TUniQuery(DataSet).Params[i];
|
|
if (lParam.ParamType in [ptOutput, ptInputOutput, ptResult]) then
|
|
Aparams.ParamByName(lParam.Name).Value := lParam.Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEUniDACQuery.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
WriteCrLabsParamValues(AParams, TUniQuery(Dataset).Params, true);
|
|
end;
|
|
|
|
{ TDAEUniDACStoredProcedure }
|
|
|
|
function TDAEUniDACStoredProcedure.CreateDataset(
|
|
aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TUniStoredProc.Create(nil);
|
|
TUniStoredProc(result).Connection := TDAEUniDACConnection(aConnection).fConnection;
|
|
end;
|
|
|
|
function TDAEUniDACStoredProcedure.DoExecute: integer;
|
|
begin
|
|
with TUniStoredProc(Dataset) do begin
|
|
ExecProc;
|
|
result := RowsAffected;
|
|
end;
|
|
end;
|
|
|
|
function TDAEUniDACStoredProcedure.Execute: integer;
|
|
var
|
|
i: integer;
|
|
_params: TDAParamCollection;
|
|
lParam: uDAInterfaces.TDAParam;
|
|
begin
|
|
_params := GetParams;
|
|
|
|
with TUniStoredProc(Dataset) do begin
|
|
for i := 0 to (Params.Count - 1) do
|
|
if (Params[i].ParamType in [ptInput, ptInputOutput]) then begin
|
|
lParam := _params.ParamByName(Params[i].Name);
|
|
if (Params[i].DataType in [ftMemo, ftBlob, ftGraphic]) and VarIsArray(lParam.Value)then
|
|
Params[i].Value := VariantToAnsiString(lParam.Value)
|
|
else
|
|
Params[i].Value := lParam.Value;
|
|
end;
|
|
|
|
result := DoExecute;
|
|
|
|
for i := 0 to (_params.Count-1) do
|
|
if (_params[i].ParamType in [daptOutput, daptInputOutput, daptResult])
|
|
then _params[i].Value := params.ParamByName(_params[i].Name).Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEUniDACStoredProcedure.GetParamValues(AParams: TDAParamCollection);
|
|
var
|
|
i: Integer;
|
|
lParam: TUniParam;
|
|
begin
|
|
for i := 0 to TUniStoredProc(DataSet).Params.Count - 1 do begin
|
|
lParam:=TUniStoredProc(DataSet).Params[i];
|
|
if (lParam.ParamType in [ptOutput, ptInputOutput, ptResult]) then
|
|
Aparams.ParamByName(lParam.Name).Value := lParam.Value;
|
|
end;
|
|
end;
|
|
|
|
function TDAEUniDACStoredProcedure.GetStoredProcedureName: string;
|
|
begin
|
|
result := TUniStoredProc(Dataset).StoredProcName;
|
|
end;
|
|
|
|
procedure TDAEUniDACStoredProcedure.RefreshParams;
|
|
begin
|
|
TUniStoredProc(Dataset).PrepareSQL;
|
|
RefreshParamsStd(TUniStoredProc(Dataset).Params);
|
|
end;
|
|
|
|
procedure TDAEUniDACStoredProcedure.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
WriteCrLabsParamValues(AParams, TUniStoredProc(Dataset).Params);
|
|
end;
|
|
|
|
procedure TDAEUniDACStoredProcedure.SetStoredProcedureName(const Name: string);
|
|
begin
|
|
TUniStoredProc(Dataset).StoredProcName := Name;
|
|
end;
|
|
|
|
{$IFNDEF DARWIN}
|
|
exports GetDriverObject name func_GetDriverObject;
|
|
{$ENDIF}
|
|
|
|
initialization
|
|
{$IFDEF FPC}
|
|
{$I DataAbstract_UniDACDriver_Glyphs.lrs}
|
|
{$ENDIF}
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
FreeAndNIL(_driver);
|
|
end.
|