david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
1010 lines
32 KiB
ObjectPascal
1010 lines
32 KiB
ObjectPascal
unit uDADBXDriver;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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}
|
|
|
|
|
|
{$R DataAbstract_DBXDriver_Glyphs.res}
|
|
|
|
interface
|
|
|
|
uses Windows,Classes, DB, uDAEngine, uDAInterfaces, uROClasses, SqlExpr,{$IFNDEF DELPHI11UP}DBXpress,{$ENDIF}
|
|
SqlConst, uDAUtils, uDAIBInterfaces, uDAAdoInterfaces,uDAMySQLInterfaces, {$IFDEF DELPHI9UP}uDASybaseInterfaces,{$ENDIF}
|
|
uDADB2Interfaces, uDAOracleInterfaces;
|
|
|
|
const
|
|
// Standard dbExpress driver identifiers
|
|
dbx_UnknownId = '???';
|
|
dbx_MSSQLId = 'MSSQL';
|
|
dbx_InterbaseId = 'Interbase';
|
|
dbx_OracleId = 'Oracle';
|
|
dbx_DB2Id = 'DB2';
|
|
dbx_MySQLId = 'MYSQL';
|
|
dbx_InformixId = 'Informix';
|
|
{$IFDEF DELPHI9UP}
|
|
dbx_ASAid = 'ASA';
|
|
dbx_ASEid = 'ASE';
|
|
{$ENDIF}
|
|
|
|
type
|
|
// Standard dbExpress driver enumerated
|
|
TDADBXDriverType = (dbx_Unknown,
|
|
dbx_MSSQL,
|
|
dbx_Interbase,
|
|
dbx_Oracle,
|
|
dbx_DB2,
|
|
dbx_MySQL,
|
|
dbx_Informix
|
|
{$IFDEF DELPHI9UP}
|
|
, dbx_ASA, dbx_ASE
|
|
{$ENDIF DELPHI9UP}
|
|
);
|
|
|
|
const
|
|
// Standard dbExpress driver identifier array (useful for lookups)
|
|
DBXDrivers: array[TDADBXDriverType] of string = (
|
|
dbx_UnknownId,
|
|
dbx_MSSQLId,
|
|
dbx_InterbaseId,
|
|
dbx_OracleId,
|
|
dbx_DB2Id,
|
|
dbx_MySQLId,
|
|
dbx_InformixId
|
|
{$IFDEF DELPHI9UP}
|
|
,dbx_ASAid, dbx_ASEid
|
|
{$ENDIF DELPHI9UP}
|
|
);
|
|
|
|
type
|
|
{ TDADBXDriver }
|
|
TDADBXDriver = class(TDADriverReference)
|
|
end;
|
|
|
|
{ TDAEDBXDriver }
|
|
TDAEDBXDriver = class(TDAEDriver, IDADriver40)
|
|
protected
|
|
function GetConnectionClass: TDAEConnectionClass; override;
|
|
|
|
// IDADriver
|
|
function GetDriverID: string; override;
|
|
function GetDescription: string; override;
|
|
|
|
procedure GetAuxDrivers(out List: IROStrings); override;
|
|
procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
|
|
|
|
function GetAvailableDriverOptions: TDAAvailableDriverOptions; override;
|
|
// IDADriver40
|
|
function GetProviderDefaultCustomParameters(Provider: string): string; safecall;
|
|
function GetDefaultConnectionType(const AuxDriver: string): string; override; safecall;
|
|
public
|
|
end;
|
|
|
|
{ IDBXConnection
|
|
For identification purposes. }
|
|
IDBXConnection = interface
|
|
['{D4E8FE6C-76B5-46FA-A850-2FD626960775}']
|
|
function GetDriverName: string;
|
|
function GetDriverType: TDADBXDriverType;
|
|
|
|
property DriverName: string read GetDriverName;
|
|
property DriverType: TDADBXDriverType read GetDriverType;
|
|
end;
|
|
|
|
{ TDBXConnection }
|
|
TDBXConnection = class(TDAConnectionWrapper)
|
|
private
|
|
fSQLConnection: TSQLConnection;
|
|
fTransDesc: TTransactionDesc;
|
|
|
|
protected
|
|
function GetConnected: Boolean; override;
|
|
procedure SetConnected(Value: Boolean); override;
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
property SQLConnection: TSQLConnection read fSQLConnection;
|
|
property TransDesc: TTransactionDesc read fTransDesc;
|
|
end;
|
|
|
|
|
|
{ TDAEDBXConnection }
|
|
TDAEDBXConnection = class(TDAEConnection, IDAFileBasedDatabase,
|
|
IDACanQueryDatabaseNames, IDAUseGenerators ,{IDAADOConnection,}
|
|
IDAInterbaseConnection, IDACanQueryGeneratorsNames,
|
|
{$IFDEF DELPHI9UP}IDASybaseConnection,{$ENDIF}
|
|
IDADB2Connection, IDAMySQLConnection,IDAOracleConnection)
|
|
private
|
|
fConnection: TDBXConnection;
|
|
fDriverName: string;
|
|
fDriverType: TDADBXDriverType;
|
|
fMSSQLSchemaEnabled: Boolean;
|
|
fSqlDialect: Integer;
|
|
FMySQLVersion: integer;
|
|
function GetMySQLVersion: integer;
|
|
protected
|
|
function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
|
|
// TDAEConnection
|
|
function CreateCustomConnection: TCustomConnection; override;
|
|
function CreateMacroProcessor: TDASQLMacroProcessor; override;
|
|
|
|
function GetDatasetClass: TDAEDatasetClass; override;
|
|
function GetStoredProcedureClass: TDAEStoredProcedureClass; override;
|
|
|
|
procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser;
|
|
aConnectionObject: TCustomConnection); override;
|
|
|
|
function DoBeginTransaction: integer; override;
|
|
procedure DoCommitTransaction; override;
|
|
procedure DoRollbackTransaction; override;
|
|
function DoGetInTransaction: boolean; override;
|
|
|
|
function GetUserID: string; override; safecall;
|
|
procedure SetUserID(const Value: string); override; safecall;
|
|
function GetPassword: string; override; safecall;
|
|
procedure SetPassword(const Value: string); override; safecall;
|
|
|
|
procedure DoGetTableNames(out List: IROStrings); override;
|
|
procedure DoGetStoredProcedureNames(out List: IROStrings); override;
|
|
procedure DoGetViewNames(out List: IROStrings); override;
|
|
procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); override;
|
|
procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); override;
|
|
procedure DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection); override;
|
|
function DoGetLastAutoInc(const GeneratorName: string): integer; override;
|
|
function IdentifierNeedsQuoting(const iIdentifier: string): boolean; override; safecall;
|
|
function GetQuoteChars: TDAQuoteCharArray; override;
|
|
// IDBXConnection
|
|
function GetDriverName: string;
|
|
function GetDriverType: TDADBXDriverType;
|
|
function GetSPSelectSyntax(HasArguments: Boolean): string; override;
|
|
safecall;
|
|
//IDAFileBasedDatabase
|
|
function GetFileExtensions: IROStrings;
|
|
//IDACanQueryDatabaseNames
|
|
function GetDatabaseNames: IROStrings;
|
|
//IDAUseGenerators
|
|
function GetNextAutoinc(const GeneratorName: string): integer; safecall;
|
|
// IDACanQueryGeneratorsNames
|
|
function GetGeneratorNames: IROStrings;
|
|
public
|
|
property MSSQLSchemaEnabled: Boolean read fMSSQLSchemaEnabled write fMSSQLSchemaEnabled;
|
|
end;
|
|
|
|
{ TDAEDBXQuery }
|
|
TDAEDBXQuery = class(TDAEDataset,IDAMustSetParams)
|
|
private
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
function IsNeedToFixFMTBCDIssue: Boolean; override;
|
|
function DoExecute: integer; override;
|
|
function DoGetSQL: string; override;
|
|
procedure DoSetSQL(const Value: string); override;
|
|
procedure DoPrepare(Value: boolean); override;
|
|
procedure ClearParams; override;
|
|
procedure SetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
public
|
|
end;
|
|
|
|
{ TDAEDBXStoredProcedure }
|
|
TDAEDBXStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
|
|
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}
|
|
procedure SetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure RefreshParams; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
function DBXDriverIdToDBXDriverType(const anID: string): TDADBXDriverType;
|
|
|
|
function GetDriverObject: IDADriver; stdcall;
|
|
|
|
implementation
|
|
|
|
uses SysUtils, INIFiles, uDADriverManager, uDARes, uDAMacroProcessors, Variants, SqlTimSt,
|
|
uROBinaryHelpers,uDASQL92Interfaces;
|
|
|
|
// TODO: Add support for IADOConnection and IInterbaseConnection, etc by redefining QueryInterface in TDAEDBXConnection
|
|
|
|
|
|
var
|
|
_driver: TDAEDriver = nil;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DAPalettePageName, [TDADBXDriver]);
|
|
end;
|
|
|
|
function GetDriverObject: IDADriver;
|
|
begin
|
|
if (_driver = nil) then _driver := TDAEDBXDriver.Create(nil);
|
|
result := _driver;
|
|
end;
|
|
|
|
function DBXDriverIdToDBXDriverType(const anID: string): TDADBXDriverType;
|
|
var
|
|
x: TDADBXDriverType;
|
|
begin
|
|
result := dbx_Unknown;
|
|
|
|
for x := Low(TDADBXDriverType) to High(TDADBXDriverType) do
|
|
if AnsiSameText(DBXDrivers[x], anID) then begin
|
|
result := x;
|
|
Exit;
|
|
end;
|
|
|
|
//RaiseError('Unknown dbExpress driver %s', [anID]);
|
|
end;
|
|
|
|
{ TDBXConnection }
|
|
|
|
constructor TDBXConnection.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fSQLConnection := TSQLConnection.Create(nil);
|
|
end;
|
|
|
|
destructor TDBXConnection.Destroy;
|
|
begin
|
|
inherited;
|
|
fSQLConnection.Free;
|
|
end;
|
|
|
|
function TDBXConnection.GetConnected: Boolean;
|
|
begin
|
|
result := fSQLConnection.Connected
|
|
end;
|
|
|
|
procedure TDBXConnection.SetConnected(Value: Boolean);
|
|
begin
|
|
fSQLConnection.Connected := Value;
|
|
end;
|
|
|
|
{ TDAEDBXConnection }
|
|
{$IFDEF DELPHI2009UP}
|
|
const
|
|
SDriverNotInConfigFile = 'Driver (%s) not found in Cfg file (%s)';
|
|
{$ENDIF}
|
|
|
|
procedure TDAEDBXConnection.DoApplyConnectionString(
|
|
aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
|
|
|
|
function GetProfileString(Section, Setting, IniFileName: string): string;
|
|
var
|
|
IniFile: TMemIniFile;
|
|
List: TStrings;
|
|
begin
|
|
List := TStringList.Create;
|
|
try
|
|
IniFile := TMemIniFile.Create(IniFileName);
|
|
IniFile.ReadSectionValues(Section, List);
|
|
try
|
|
Result := List.Values[Setting];
|
|
finally
|
|
IniFile.Free;
|
|
end;
|
|
finally
|
|
List.Free;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
i: integer;
|
|
drvregfile: string;
|
|
begin
|
|
inherited;
|
|
FMySQLVersion := -1;
|
|
with aConnStrParser do begin
|
|
|
|
with TDBXConnection(aConnectionObject).SQLConnection do begin
|
|
DriverName := AuxDriver;
|
|
|
|
fDriverType := DBXDriverIdToDBXDriverType(AuxDriver);
|
|
|
|
drvregfile := GetDriverRegistryFile(false);
|
|
|
|
try
|
|
VendorLib := GetProfileString(DriverName, VENDORLIB_KEY, drvregfile);
|
|
LibraryName := GetProfileString(DriverName, DLLLIB_KEY, drvregfile);
|
|
GetDriverFunc := GetProfileString(DriverName, GETDRIVERFUNC_KEY, drvregfile);
|
|
except
|
|
DatabaseErrorFmt(SDriverNotInConfigFile, [DriverName, drvregfile]);
|
|
end;
|
|
|
|
Params.Clear;
|
|
Params.Values[szUSERNAME] := UserID;
|
|
Params.Values[szPASSWORD] := Password;
|
|
if fDriverType = dbx_Interbase then begin // Dbx requires a seperate host field for Interbase
|
|
Params.Values[DATABASENAME_KEY] := Server + ':' + Database;
|
|
if auxParams[SQLDIALECT_KEY] = '' then begin
|
|
AuxParams[SQLDIALECT_KEY] := '3'; // default to 3
|
|
end;
|
|
end else begin
|
|
Params.Values[HOSTNAME_KEY] := Server;
|
|
Params.Values[DATABASENAME_KEY] := Database;
|
|
end;
|
|
fMSSQLSchemaEnabled := false;
|
|
for i := 0 to (AuxParamsCount - 1) do begin
|
|
if AnsiSameText(AuxParamNames[i], 'DriverName') then
|
|
fConnection.fSQLConnection.DriverName:=AuxParams[AuxParamNames[i]]
|
|
else if AnsiSameText(AuxParamNames[i], 'GetDriverFunc') then
|
|
fConnection.fSQLConnection.GetDriverFunc:=AuxParams[AuxParamNames[i]]
|
|
else if AnsiSameText(AuxParamNames[i], 'LibraryName') then
|
|
fConnection.fSQLConnection.LibraryName:=AuxParams[AuxParamNames[i]]
|
|
else if AnsiSameText(AuxParamNames[i], 'TableScope') then begin
|
|
if AnsiSameText(AuxParams[AuxParamNames[i]], 'Synonyms') then
|
|
TableScope := [tsTable, tsView, tsSynonym]
|
|
else
|
|
TableScope := [tsTable, tsView]
|
|
end
|
|
else if AnsiSameText(AuxParamNames[i], 'Schemas') then
|
|
fMSSQLSchemaEnabled := AuxParams['Schemas'] = '1'
|
|
else begin
|
|
Params.Add(AuxParamNames[i] + '=' + AuxParams[AuxParamNames[i]]);
|
|
end;
|
|
end;
|
|
LoginPrompt := FALSE;
|
|
if fDriverType = dbx_Interbase then fSqlDialect := StrToIntDef(AuxParams[SQLDIALECT_KEY],3);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXConnection.DoBeginTransaction: integer;
|
|
begin
|
|
result := -1;
|
|
|
|
// TODO: allow more flexibility here...
|
|
fConnection.fTransDesc.TransactionID := 1;
|
|
fConnection.fTransDesc.IsolationLevel := xilREADCOMMITTED;
|
|
{$IFDEF DELPHI10UP}{$WARN SYMBOL_DEPRECATED OFF}{$ENDIF}
|
|
fConnection.fSQLConnection.StartTransaction(fConnection.fTransDesc);
|
|
{$IFDEF DELPHI10UP}{$WARN SYMBOL_DEPRECATED ON}{$ENDIF}
|
|
end;
|
|
|
|
procedure TDAEDBXConnection.DoCommitTransaction;
|
|
begin
|
|
{$IFDEF DELPHI10UP}{$WARN SYMBOL_DEPRECATED OFF}{$ENDIF}
|
|
fConnection.fSQLConnection.Commit(fConnection.fTransDesc);
|
|
{$IFDEF DELPHI10UP}{$WARN SYMBOL_DEPRECATED ON}{$ENDIF}
|
|
end;
|
|
|
|
function TDAEDBXConnection.CreateCustomConnection: TCustomConnection;
|
|
begin
|
|
fConnection := TDBXConnection.Create(nil);
|
|
fConnection.SQLConnection.LoginPrompt := FALSE;
|
|
result := fConnection;
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
result := TDAEDBXQuery;
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
result := TDAEDBXStoredProcedure;
|
|
end;
|
|
|
|
procedure TDAEDBXConnection.DoGetStoredProcedureNames(out List: IROStrings);
|
|
begin
|
|
inherited DoGetStoredProcedureNames(List);
|
|
case fDriverType of
|
|
dbx_MSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure, MSSQLSchemaEnabled);
|
|
dbx_Interbase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotProcedure);
|
|
dbx_MySQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure,fConnection.SQLConnection.Params.Values[DATABASENAME_KEY],GetMySQLVersion);
|
|
dbx_Oracle: Oracle_DoGetNames(GetDatasetClass.Create(Self), List, dotProcedure);
|
|
else
|
|
{$IFDEF DELPHI10UP}{$WARN SYMBOL_DEPRECATED OFF}{$ENDIF}
|
|
fConnection.fSQLConnection.GetProcedureNames(List.Strings);
|
|
{$IFDEF DELPHI10UP}{$WARN SYMBOL_DEPRECATED ON}{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEDBXConnection.DoGetStoredProcedureParams(
|
|
const aStoredProcedureName: string; out Params: TDAParamCollection);
|
|
begin
|
|
case fDriverType of
|
|
dbx_MySQL: MYSQL_DoGetStoredProcedureParams(aStoredProcedureName,GetDatasetClass.Create(Self),Params,fConnection.SQLConnection.Params.Values[DATABASENAME_KEY]);
|
|
dbx_MSSQL: MSSQL_DoGetStoredProcedureParams(aStoredProcedureName,GetDatasetClass.Create(Self),Params);
|
|
else
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEDBXConnection.DoGetTableNames(out List: IROStrings);
|
|
begin
|
|
inherited DoGetTableNames(List);
|
|
case fDriverType of
|
|
dbx_MSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotTable, MSSQLSchemaEnabled);
|
|
dbx_Interbase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotTable);
|
|
dbx_MySQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotTable,fConnection.SQLConnection.Params.Values[DATABASENAME_KEY],GetMySQLVersion);
|
|
dbx_Oracle: Oracle_DoGetNames(GetDatasetClass.Create(Self), List, dotTable);
|
|
else
|
|
fConnection.fSQLConnection.GetTableNames(List.Strings);
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEDBXConnection.DoRollbackTransaction;
|
|
begin
|
|
{$WARNINGS OFF}
|
|
fConnection.fSQLConnection.Rollback(fConnection.fTransDesc);
|
|
{$WARNINGS ON}
|
|
end;
|
|
|
|
function TDAEDBXConnection.DoGetInTransaction: boolean;
|
|
begin
|
|
result := fConnection.fSQLConnection.InTransaction
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetDriverName: string;
|
|
begin
|
|
result := fDriverName
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetDriverType: TDADBXDriverType;
|
|
begin
|
|
result := fDriverType
|
|
end;
|
|
|
|
function TDAEDBXConnection.CreateMacroProcessor: TDASQLMacroProcessor;
|
|
begin
|
|
case fDriverType of
|
|
dbx_MSSQL: result := MSSQL_CreateMacroProcessor;
|
|
dbx_Interbase: result := IB_CreateMacroProcessor;
|
|
dbx_Oracle: result := Oracle_CreateMacroProcessor;
|
|
else
|
|
result := inherited CreateMacroProcessor;
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetPassword: string;
|
|
begin
|
|
Result := fConnection.SQLConnection.Params.Values[szPASSWORD];
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetUserID: string;
|
|
begin
|
|
Result := fConnection.SQLConnection.Params.Values[szUSERNAME];
|
|
end;
|
|
|
|
procedure TDAEDBXConnection.SetPassword(const Value: string);
|
|
begin
|
|
fConnection.SQLConnection.Params.Values[szPASSWORD] := Value;
|
|
end;
|
|
|
|
procedure TDAEDBXConnection.SetUserID(const Value: string);
|
|
begin
|
|
fConnection.SQLConnection.Params.Values[szUSERNAME] := Value;
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetSPSelectSyntax(
|
|
HasArguments: Boolean): string;
|
|
begin
|
|
case fDriverType of
|
|
dbx_MSSQL: Result := MSSQL_GetSPSelectSyntax(HasArguments);
|
|
dbx_Interbase: Result := IB_GetSPSelectSyntax(HasArguments);
|
|
dbx_Oracle: Result := Oracle_GetSPSelectSyntax(HasArguments);
|
|
else
|
|
Result := inherited GetSPSelectSyntax(HasArguments);
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetFileExtensions: IROStrings;
|
|
begin
|
|
case fDriverType of
|
|
dbx_Interbase: result := IB_GetFileExtensions;
|
|
else
|
|
result := TROStrings.Create;
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetGeneratorNames: IROStrings;
|
|
begin
|
|
case fDriverType of
|
|
dbx_Interbase: Result:= IB_GetGeneratorNames(GetDatasetClass.Create(Self));
|
|
else
|
|
Result := NewROStrings;
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXConnection.QueryInterface(const IID: TGUID;
|
|
out Obj): HResult;
|
|
begin
|
|
Result := E_NOINTERFACE;
|
|
|
|
{$IFDEF DELPHI9UP}
|
|
if IsEqualGUID(IID, IDASybaseConnection) then begin
|
|
if not (fDriverType in [dbx_ASA, dbx_ASE]) then Exit;
|
|
end
|
|
else
|
|
{$ENDIF}
|
|
if IsEqualGUID(IID, IDADB2Connection) then begin
|
|
if not (fDriverType in [dbx_DB2]) then Exit;
|
|
end
|
|
else if IsEqualGUID(IID, IDAInterbaseConnection) then begin
|
|
if not (fDriverType in [dbx_Interbase]) then Exit;
|
|
end
|
|
else if IsEqualGUID(IID, IDAADOConnection) then begin
|
|
if not (fDriverType in [dbx_MSSQL]) then Exit;
|
|
end
|
|
else if IsEqualGUID(IID, IDAMySQLConnection) then begin
|
|
if not (fDriverType in [dbx_MySQL]) then Exit;
|
|
end
|
|
else if IsEqualGUID(IID, IDAOracleConnection) then begin
|
|
if not (fDriverType in [dbx_Oracle]) then Exit;
|
|
end
|
|
else if IsEqualGUID(IID, IDAUseGenerators) then begin
|
|
if not (fDriverType in [dbx_Interbase,dbx_Oracle]) then Exit;
|
|
end
|
|
else if IsEqualGUID(IID, IDACanQueryGeneratorsNames) then begin
|
|
if not (fDriverType in [dbx_Interbase]) then Exit;
|
|
end
|
|
else if IsEqualGUID(IID, IDAFileBasedDatabase) then begin
|
|
if not (fDriverType in [dbx_Interbase]) then Exit;
|
|
end
|
|
else if IsEqualGUID(IID, IDACanQueryDatabaseNames) then begin
|
|
if not (fDriverType in [dbx_MSSQL, dbx_Oracle, dbx_MySQL {$IFDEF DELPHI9UP}, dbx_ASA, dbx_ASE{$ENDIF DELPHI9UP}]) then Exit;
|
|
end;
|
|
|
|
Result := inherited QueryInterface(IID, Obj);
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetDatabaseNames: IROStrings;
|
|
begin
|
|
case fDriverType of
|
|
dbx_MSSQL: Result:=MSSQL_GetDatabaseNames(Self);
|
|
dbx_MySQL: Result:=MYSQL_GetDatabaseNames(Self);
|
|
else
|
|
Result := NewROStrings;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEDBXConnection.DoGetViewNames(out List: IROStrings);
|
|
begin
|
|
inherited DoGetViewNames(List);
|
|
case fDriverType of
|
|
dbx_MSSQL: MSSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotView, MSSQLSchemaEnabled);
|
|
dbx_Interbase: IB_GetObjectNames(GetDatasetClass.Create(Self), List, dotView);
|
|
dbx_MySQL: MYSQL_DoGetNames(GetDatasetClass.Create(Self), List, dotView,fConnection.SQLConnection.Params.Values[DATABASENAME_KEY],GetMySQLVersion);
|
|
dbx_Oracle: Oracle_DoGetNames(GetDatasetClass.Create(Self), List, dotView);
|
|
else
|
|
//
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEDBXConnection.DoGetForeignKeys(
|
|
out ForeignKeys: TDADriverForeignKeyCollection);
|
|
begin
|
|
inherited DoGetForeignKeys(ForeignKeys);
|
|
case fDriverType of
|
|
dbx_MSSQL: MSSQL_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys, MSSQLSchemaEnabled);
|
|
dbx_Interbase: IB_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys);
|
|
dbx_MySQL: MYSQL_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys,fConnection.SQLConnection.Params.Values[DATABASENAME_KEY],GetMySQLVersion);
|
|
dbx_ORACLE: Oracle_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys);
|
|
else
|
|
//
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEDBXConnection.DoGetTableFields(const aTableName: string;
|
|
out Fields: TDAFieldCollection);
|
|
begin
|
|
case fDriverType of
|
|
dbx_MSSQL: MSSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
|
|
dbx_Interbase: IB_GetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
|
|
dbx_MySQL: MYSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields,fConnection.SQLConnection.Params.Values[DATABASENAME_KEY],GetMySQLVersion);
|
|
dbx_Oracle: Oracle_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), GetDatasetClass.Create(Self), Fields);
|
|
else
|
|
inherited DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), Fields);
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXConnection.DoGetLastAutoInc(
|
|
const GeneratorName: string): integer;
|
|
begin
|
|
case fDriverType of
|
|
dbx_MSSQL: Result := MSSQL_DoGetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
dbx_Interbase: Result := IB_GetLastAutoInc(GeneratorName, GetDatasetClass.Create(Self));
|
|
dbx_Oracle: Result := Oracle_DoGetLastAutoInc(GeneratorName,GetDatasetClass.Create(Self));
|
|
dbx_MySQL: Result := MySQL_GetLastAutoInc(GeneratorName,GetDatasetClass.Create(Self));
|
|
else
|
|
Result := inherited DoGetLastAutoInc(GeneratorName);
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetNextAutoinc(
|
|
const GeneratorName: string): integer;
|
|
begin
|
|
case fDriverType of
|
|
dbx_Interbase: Result := IB_GetNextAutoinc(GeneratorName, GetDatasetClass.Create(Self));
|
|
dbx_Oracle: Result := Oracle_GetNextAutoinc(GeneratorName, GetDatasetClass.Create(Self));
|
|
else
|
|
result := -1;
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXConnection.IdentifierNeedsQuoting(
|
|
const iIdentifier: string): boolean;
|
|
begin
|
|
Result := inherited IdentifierNeedsQuoting(iIdentifier);
|
|
if not Result then
|
|
case fDriverType of
|
|
dbx_MSSQL: Result := MSSQL_IdentifierNeedsQuoting(iIdentifier);
|
|
dbx_Interbase: Result := IB_IdentifierNeedsQuoting(iIdentifier, fSqlDialect);
|
|
dbx_MySQL: Result := MYSQL_IdentifierNeedsQuoting(iIdentifier);
|
|
dbx_ORACLE: Result := Oracle_IdentifierNeedsQuoting(iIdentifier);
|
|
dbx_DB2: Result := DB2_IdentifierNeedsQuoting(iIdentifier);
|
|
{$IFDEF DELPHI9UP}
|
|
dbx_ASA, dbx_ASE: Result := Sybase_IdentifierNeedsQuoting(iIdentifier);
|
|
{$ENDIF DELPHI9UP}
|
|
else
|
|
Result:= SQL92_IdentifierNeedsQuoting(iIdentifier);
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetQuoteChars: TDAQuoteCharArray;
|
|
begin
|
|
case fDriverType of
|
|
dbx_Oracle: Result:=Oracle_GetQuoteChars;
|
|
else
|
|
Result:= inherited GetQuoteChars;
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXConnection.GetMySQLVersion: integer;
|
|
begin
|
|
if FMySQLVersion = -1 then FMySQLVersion := MYSQL_GetVersion(GetDatasetClass.Create(Self));
|
|
Result := FMySQLVersion;
|
|
end;
|
|
|
|
{ TDAEDBXDriver }
|
|
|
|
function TDAEDBXDriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
|
|
begin
|
|
result := [doAuxDriver, doServerName, doDatabaseName, doLogin, doCustom];
|
|
end;
|
|
|
|
function TDAEDBXDriver.GetConnectionClass: TDAEConnectionClass;
|
|
begin
|
|
result := TDAEDBXConnection;
|
|
end;
|
|
|
|
function TDAEDBXDriver.GetDefaultConnectionType(
|
|
const AuxDriver: string): string;
|
|
begin
|
|
case DBXDriverIdToDBXDriverType(AuxDriver) of
|
|
dbx_MSSQL: Result:=MSSQL_DriverType;
|
|
dbx_Interbase: Result:=IB_DriverType;
|
|
dbx_Oracle: Result:=Oracle_DriverType;
|
|
dbx_DB2: Result:=DB2_DriverType;
|
|
dbx_MySQL: Result:=MySQL_DriverType;
|
|
dbx_Informix: Result:=Informix_DriverType;
|
|
{$IFDEF DELPHI9UP}
|
|
dbx_ASA,dbx_ASE : Result:=ASA_DriverType;
|
|
{$ENDIF DELPHI9UP}
|
|
else
|
|
Result := inherited GetDefaultConnectionType(AuxDriver);
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXDriver.GetDescription: string;
|
|
begin
|
|
result := 'Borland DBXExpress Driver';
|
|
end;
|
|
|
|
function TDAEDBXDriver.GetDriverID: string;
|
|
begin
|
|
result := 'DBX';
|
|
end;
|
|
|
|
procedure TDAEDBXDriver.GetAuxDrivers(out List: IROStrings);
|
|
var
|
|
i: Integer;
|
|
lDriversIni: string;
|
|
x: TDADBXDriverType;
|
|
begin
|
|
List := NewROStrings;
|
|
|
|
lDriversIni := GetDriverRegistryFile(false);
|
|
if FileExists(lDriversIni) then begin
|
|
with TMemIniFile.Create(lDriversIni) do try
|
|
ReadSections(List.Strings);
|
|
for i := List.Count - 1 downto 0 do begin
|
|
if not ValueExists(List[i], 'LibraryName') then List.Delete(i);
|
|
end; { for }
|
|
finally
|
|
Free();
|
|
end;
|
|
end
|
|
else begin
|
|
for x := Low(TDADBXDriverType) to High(TDADBXDriverType) do
|
|
if (x <> dbx_Unknown) {// Redundant but safe if I change the enum later...} then
|
|
List.Add(DBXDrivers[x])
|
|
end;
|
|
List.Sorted:=True;
|
|
end;
|
|
|
|
procedure TDAEDBXDriver.GetAuxParams(const AuxDriver: string;
|
|
out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
List.Add('TableScope=Synonyms');
|
|
List.Add('DriverName=<DriverName>');
|
|
List.Add('GetDriverFunc=<GetDriverFunc>');
|
|
List.Add('LibraryName=<LibraryName>');
|
|
case DBXDriverIdToDBXDriverType(AuxDriver) of
|
|
dbx_MSSQL: List.Add('Schemas=(0,1)');
|
|
dbx_Interbase: List.Add('Interbase TransIsolation=(ReadCommited,RepeatableRead)');
|
|
end;
|
|
end;
|
|
|
|
function TDAEDBXDriver.GetProviderDefaultCustomParameters(
|
|
Provider: string): string;
|
|
begin
|
|
Result := '';
|
|
case DBXDriverIdToDBXDriverType(Provider) of
|
|
dbx_MSSQL: Result := 'Schemas=0;';
|
|
dbx_Interbase: Result:='Interbase TransIsolation=ReadCommited;';
|
|
end;
|
|
end;
|
|
|
|
{ TDAEDBXQuery }
|
|
|
|
procedure TDAEDBXQuery.ClearParams;
|
|
begin
|
|
inherited;
|
|
TSQLQuery(Dataset).Params.Clear;
|
|
end;
|
|
|
|
function TDAEDBXQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TSQLQuery.Create(nil);
|
|
|
|
//TSQLQuery(result).rea
|
|
//TSQLQuery(result).CursorLocation := clUseClient;
|
|
//TSQLQuery(result).CursorType := ctOpenForwardOnly;
|
|
TSQLQuery(result).SQLConnection := TDAEDBXConnection(aConnection).fConnection.fSQLConnection;
|
|
end;
|
|
|
|
{$IFNDEF DELPHI12UP}
|
|
function GetBlobValue(const val: Variant): string;
|
|
var
|
|
lsize: integer;
|
|
p: Pointer;
|
|
begin
|
|
if VarType(val) = 8209 then
|
|
begin
|
|
lSize := VarArrayHighBound(val, 1) - VarArrayLowBound(val, 1) + 1;
|
|
p := VarArrayLock(val);
|
|
try
|
|
setlength(REsult, lSize);
|
|
move(p^, Result[1], lSize);
|
|
finally
|
|
VarArrayUnlock(val);
|
|
end;
|
|
end else if vartype(val) = varEmpty then
|
|
result := ''
|
|
else
|
|
result := val;
|
|
end;
|
|
{$ELSE}
|
|
function GetBlobValue(const val: Variant): TBytes;
|
|
var
|
|
Data: UnicodeString;
|
|
lData: Ansistring;
|
|
Len: Integer;
|
|
lsize: integer;
|
|
p: Pointer;
|
|
begin
|
|
if VarType(val) = 8209 then begin
|
|
lSize := VarArrayHighBound(val, 1) - VarArrayLowBound(val, 1) + 1;
|
|
p := VarArrayLock(val);
|
|
try
|
|
setlength(Result, lSize);
|
|
move(p^, Result[0], lSize);
|
|
finally
|
|
VarArrayUnlock(val);
|
|
end;
|
|
end
|
|
else if vartype(val) = varEmpty then
|
|
Result := Null
|
|
else if (VarType(Val) = varOleStr) or (VarType(Val) = varUString) then begin
|
|
Data := VarToStr(Val);
|
|
Len := Length(Data);
|
|
SetLength(Result, Len * SizeOf(Char));
|
|
Move(Pointer(Data)^, Pointer(Result)^, Len * SizeOf(Char));
|
|
end
|
|
else if VarType(Val) = varString then begin
|
|
lData := PAnsiChar(TVarData(Val).vString);
|
|
Len := Length(lData);
|
|
SetLength(Result, Len);
|
|
Move(Pointer(lData)^, Pointer(Result)^, Len);
|
|
end
|
|
else
|
|
Result := val;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TDAEDBXQuery.DoExecute: integer;
|
|
var
|
|
i: Integer;
|
|
refParams: TParams;
|
|
dapar: TDAParam;
|
|
lDriverName: string;
|
|
begin
|
|
if Assigned(DataSet) and Assigned(TSQLQuery(DataSet).SQLConnection) and
|
|
Assigned(TSQLQuery(DataSet).Params) then begin
|
|
lDriverName := TSQLQuery(DataSet).SQLConnection.DriverName;
|
|
refParams := TSQLQuery(DataSet).Params;
|
|
case DBXDriverIdToDBXDriverType(lDriverName) of
|
|
dbx_Oracle: begin
|
|
for i := 0 to refParams.Count - 1 do begin
|
|
case VarType(refParams[i].Value) of
|
|
varInteger,
|
|
varSmallInt,
|
|
varShortInt,
|
|
varWord,
|
|
varByte,
|
|
varLongWord:
|
|
refParams[i].AsString := VarToStr(refParams[i].Value);
|
|
varSingle,
|
|
varDouble,
|
|
varCurrency:
|
|
refParams[i].AsBCD := StrToCurr(VarToStr(refParams[i].Value));
|
|
varDate:
|
|
refParams[i].AsSQLTimeStamp := DateTimeToSQLTimeStamp(VarToDateTime(refParams[i].Value));
|
|
end;
|
|
end;
|
|
end;
|
|
dbx_Interbase: begin
|
|
for i := 0 to refParams.Count - 1 do begin
|
|
dapar := GetParams.FindParam(refParams[i].Name);
|
|
if (dapar <> nil) then begin
|
|
if dapar.DataType = datBlob then begin
|
|
refParams[i].AsBlob := GetBlobValue(dapar.AsVariant);
|
|
continue;
|
|
end;
|
|
if dapar.DataType = datMemo then begin
|
|
refParams[i].AsMemo := dapar.AsVariant;
|
|
continue;
|
|
end;
|
|
end;
|
|
case VarType(refParams[i].Value) of
|
|
varDate:
|
|
refParams[i].AsSQLTimeStamp := DateTimeToSQLTimeStamp(VarToDateTime(refParams[i].Value));
|
|
end;
|
|
end;
|
|
end;
|
|
else ;
|
|
end;
|
|
end;
|
|
|
|
Result := TSQLQuery(Dataset).ExecSQL;
|
|
end;
|
|
|
|
function TDAEDBXQuery.DoGetSQL: string;
|
|
begin
|
|
result := TSQLQuery(Dataset).SQL.Text;
|
|
end;
|
|
|
|
procedure TDAEDBXQuery.DoPrepare(Value: boolean);
|
|
begin
|
|
TSQLQuery(Dataset).Prepared := Value;
|
|
end;
|
|
|
|
procedure TDAEDBXQuery.DoSetSQL(const Value: string);
|
|
begin
|
|
TSQLQuery(Dataset).SQL.Text := Value;
|
|
end;
|
|
|
|
procedure TDAEDBXQuery.GetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
GetParamValuesStd(AParams, TSQLQuery(Dataset).Params);
|
|
end;
|
|
|
|
function TDAEDBXQuery.IsNeedToFixFMTBCDIssue: Boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result:=False;
|
|
For i:=0 to TSQLQuery(Dataset).FieldCount-1 do begin
|
|
Result:= TSQLQuery(Dataset).Fields[i].DataType = ftFMTBcd;
|
|
if Result then Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEDBXQuery.SetParamValues(AParams: TDAParamCollection);
|
|
var
|
|
i: integer;
|
|
p: TParams;
|
|
begin
|
|
SetParamValuesStd(AParams, TSQLQuery(Dataset).Params);
|
|
p := TSQLQuery(Dataset).Params;
|
|
for I := 0 to p.Count - 1 do
|
|
if p[i].DataType = ftLargeint then
|
|
p[i].DataType := ftFMTBcd;
|
|
end;
|
|
|
|
{ TDAEDBXStoredProcedure }
|
|
|
|
function TDAEDBXStoredProcedure.CreateDataset(
|
|
aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TSQLStoredProc.Create(nil);
|
|
TSQLStoredProc(result).SQLConnection := TDAEDBXConnection(aConnection).fConnection.fSQLConnection;
|
|
end;
|
|
|
|
procedure TDAEDBXStoredProcedure.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
SetParamValuesStd(AParams, TSQLStoredProc(Dataset).Params);
|
|
end;
|
|
|
|
procedure TDAEDBXStoredProcedure.GetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
GetParamValuesStd(AParams, TSQLStoredProc(Dataset).Params);
|
|
end;
|
|
|
|
function TDAEDBXStoredProcedure.Execute: integer;
|
|
begin
|
|
SetParamValues(GetParams);
|
|
Result:= DoExecute;
|
|
GetParamValues(GetParams);
|
|
end;
|
|
|
|
function TDAEDBXStoredProcedure.GetStoredProcedureName: string;
|
|
begin
|
|
result := TSQLStoredProc(Dataset).StoredProcName;
|
|
end;
|
|
|
|
procedure TDAEDBXStoredProcedure.SetStoredProcedureName(
|
|
const Name: string);
|
|
begin
|
|
TSQLStoredProc(Dataset).StoredProcName := Name;
|
|
end;
|
|
|
|
procedure TDAEDBXStoredProcedure.RefreshParams;
|
|
begin
|
|
TSQLStoredProc(Dataset).Prepared := True;
|
|
RefreshParamsStd(TSQLStoredProc(Dataset).Params)
|
|
end;
|
|
|
|
exports
|
|
GetDriverObject name func_GetDriverObject;
|
|
|
|
function TDAEDBXStoredProcedure.DoExecute: integer;
|
|
begin
|
|
Result := TSQLStoredProc(Dataset).ExecProc;
|
|
end;
|
|
|
|
initialization
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
FreeAndNIL(_driver);
|
|
end.
|
|
|