Componentes.Terceros.RemObj.../internal/5.0.23.613/1/Data Abstract for Delphi/Source/Drivers/uDADBXDriver.pas
david 2824855ea7 - Modificación del paquete RemObjects_Core_D10 para que sea un paquete de runtime/designtime (antes era designtime sólo)
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10
- Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10

git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
2007-09-10 14:06:19 +00:00

938 lines
29 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}
{$ENDIF MSWINDOWS}
{$IFDEF LINUX}
{$I ../DataAbstract.inc}
{$ENDIF LINUX}
{$R DataAbstract_DBXDriver_Glyphs.res}
interface
uses Windows,Classes, DB, uDAEngine, uDAInterfaces, uROClasses, SqlExpr, DBXpress,
SqlConst, uDAUtils, uDAIBInterfaces, uDAAdoInterfaces,uDAMySQLInterfaces;
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)
private
fConnection: TDBXConnection;
fDriverName: string;
fDriverType: TDADBXDriverType;
fMSSQLSchemaEnabled: Boolean;
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;
// 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)
private
protected
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
function IsNeedCreateFieldDefs: Boolean; override;
function IsNeedToFixFMTBCDIssue: Boolean; override;
function DoExecute: integer; override;
function DoGetSQL: string; override;
procedure DoSetSQL(const Value: string); override;
procedure DoPrepare(Value: boolean); override;
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 Execute: integer; override;
procedure SetParamValues(Params: TDAParamCollection); safecall;
procedure GetParamValues(Params: TDAParamCollection); safecall;
procedure RefreshParams; override;
end;
procedure Register;
function DBXDriverIdToDBXDriverType(const anID: string): TDADBXDriverType;
function GetDriverObject: IDADriver; stdcall;
implementation
uses SysUtils, INIFiles, uDADriverManager, uDARes, uDAMacroProcessors, Variants, SqlTimSt,
uROBinaryHelpers,uDASQL92Interfaces,uDAOracleInterfaces;
// 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 }
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;
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;
end;
end;
end;
function TDAEDBXConnection.DoBeginTransaction: integer;
begin
result := -1;
// TODO: allow more flexibility here...
fConnection.fTransDesc.TransactionID := 1;
fConnection.fTransDesc.IsolationLevel := xilREADCOMMITTED;
fConnection.fSQLConnection.StartTransaction(fConnection.fTransDesc);
end;
procedure TDAEDBXConnection.DoCommitTransaction;
begin
fConnection.fSQLConnection.Commit(fConnection.fTransDesc);
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]);
else
{$IFDEF DELPHI10}{$WARN SYMBOL_DEPRECATED OFF}{$ENDIF}
fConnection.fSQLConnection.GetProcedureNames(List.Strings);
{$IFDEF DELPHI10}{$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]);
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]);
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;
if IsEqualGUID(IID, IDAInterbaseConnection) then begin
if not (fDriverType in [dbx_Interbase]) then Exit;
end;
if IsEqualGUID(IID, IDAADOConnection) then begin
if not (fDriverType in [dbx_MSSQL]) then Exit;
end;
if IsEqualGUID(IID, IDAMySQLConnection) then begin
if not (fDriverType in [dbx_MySQL]) then Exit;
end;
if IsEqualGUID(IID, IDAUseGenerators) then begin
if not (fDriverType in [dbx_Interbase,dbx_Oracle]) then Exit;
end;
if IsEqualGUID(IID, IDACanQueryGeneratorsNames) then begin
if not (fDriverType in [dbx_Interbase]) then Exit;
end;
if IsEqualGUID(IID, IDAFileBasedDatabase) then begin
if not (fDriverType in [dbx_Interbase]) then Exit;
end;
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(GetDatasetClass.Create(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]);
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]);
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]);
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);
dbx_MySQL: Result := MYSQL_IdentifierNeedsQuoting(iIdentifier);
else
Result:= SQL92_IdentifierNeedsQuoting(iIdentifier);
end;
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 }
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;
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;
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;
inherited DoExecute;
result := TSQLQuery(Dataset).RowsAffected;
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;
function TDAEDBXQuery.IsNeedCreateFieldDefs: Boolean;
begin
Result:=True;
end;
function TDAEDBXQuery.IsNeedToFixFMTBCDIssue: Boolean;
begin
Result:=True;
end;
{ TDAEDBXStoredProcedure }
function TDAEDBXStoredProcedure.CreateDataset(
aConnection: TDAEConnection): TDataset;
begin
result := TSQLStoredProc.Create(nil);
TSQLStoredProc(result).SQLConnection := TDAEDBXConnection(aConnection).fConnection.fSQLConnection;
end;
procedure TDAEDBXStoredProcedure.SetParamValues(Params: TDAParamCollection);
var
i: integer;
sqPar: TParam;
begin
for i := 0 to (Params.Count - 1) do
if (Params[i].ParamType in [daptInput, daptInputOutput, daptUnknown]) then begin
sqPar := TSQLStoredProc(Dataset).ParamByName(Params[i].Name);
if (Params[i].DataType <> datBlob) then
sqPar.Value := params[i].Value
else begin
sqPar.AsBlob := VariantBinaryToString(params[i].Value);
end;
end;
end;
procedure TDAEDBXStoredProcedure.GetParamValues(Params: TDAParamCollection);
var
i: integer;
sqPar: TParam;
begin
for i := 0 to (Params.Count - 1) do
if (Params[i].ParamType in [daptOutput, daptInputOutput, daptResult]) then begin
sqPar := TSQLStoredProc(Dataset).ParamByName(Params[i].Name);
params[i].Value := sqPar.Value
end;
end;
function TDAEDBXStoredProcedure.Execute: integer;
begin
SetParamValues(GetParams);
TSQLStoredProc(Dataset).ExecProc;
result := -1;
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;
var
dsparams: TParams;
i: integer;
par: TDAParam;
params: TDAParamCollection;
nme: string;
begin
// Must override completely because the parameters' size is not reflected correctly via IProviderSupport!!
dsparams := TSQLStoredProc(Dataset).Params;
TSQLStoredProc(Dataset).Prepared := True;
params := GetParams;
params.Clear;
for i := 0 to (dsparams.Count - 1) do begin
par := params.Add;
nme := dsparams[i].Name;
System.Delete(nme, Pos('@', nme), 1);
par.Name := nme;
par.DataType := VCLTypeToDAType(dsparams[i].DataType);
par.ParamType := TDAParamType(dsparams[i].ParamType);
par.Size := dsparams[i].Size;
end;
end;
exports
GetDriverObject name func_GetDriverObject;
initialization
_driver := nil;
RegisterDriverProc(GetDriverObject);
finalization
UnregisterDriverProc(GetDriverObject);
FreeAndNIL(_driver);
end.