david
2824855ea7
- 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
1083 lines
35 KiB
ObjectPascal
1083 lines
35 KiB
ObjectPascal
unit uDANexusDBDriver;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Driver Library
|
|
{
|
|
{ compiler: Delphi 6 and up
|
|
{ platform: Win32
|
|
{
|
|
{ (c)opyright RemObjects Software. all rights reserved.
|
|
{ (c)opyright Nexus Database Systems Pty. Ltd.
|
|
{
|
|
{ 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}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
DB,
|
|
|
|
uDAEngine,
|
|
uDAInterfaces,
|
|
uROClasses,
|
|
|
|
nxllMemoryManager,
|
|
nxllSync,
|
|
nxllComponent,
|
|
nxllTransport,
|
|
|
|
nxsdServerEngine,
|
|
|
|
nxdb,
|
|
|
|
{$IFNDEF DataAbstract_NexusDBPack}
|
|
nxptBasePooledTransport,
|
|
nxtwWinsockTransport,
|
|
nxtnNamedPipeTransport,
|
|
|
|
nxreRemoteServerEngine,
|
|
{$ENDIF}
|
|
|
|
nxsrSqlEngineBase,
|
|
nxsrServerEngine,
|
|
|
|
nxsqlEngine,
|
|
|
|
//nx1xAllEngines,
|
|
nxseAllEngines, // // NXDB2: Renamed
|
|
uDAUtils;
|
|
|
|
type
|
|
TDANexusDBDriver = class(TDADriverReference)
|
|
end;
|
|
|
|
INexusDBConnection = interface
|
|
['{DFF41623-A766-44C0-A61A-CC18FB80CAE3}']
|
|
end;
|
|
|
|
INexusDBDriver = interface
|
|
['{CFE4B5BB-3C38-40BF-BE57-5BE3C627A6C3}']
|
|
procedure RegisterServerEngine(aServerEngine: TnxBaseServerEngine;
|
|
const aName: string); safecall;
|
|
|
|
procedure UnregisterServerEngine(aServerEngine: TnxBaseServerEngine); overload; safecall;
|
|
procedure UnregisterServerEngine(const aName: string); overload; safecall;
|
|
end;
|
|
|
|
TNexusDBConnection = class;
|
|
|
|
TNexusDBBaseEngineContainer = class(TnxObject)
|
|
protected {private}
|
|
becServerName: string;
|
|
|
|
becConnectionsHead : TNexusDBConnection;
|
|
becConnectionsTail : TNexusDBConnection;
|
|
protected
|
|
function becGetEngine: TnxBaseServerEngine; virtual; abstract;
|
|
public
|
|
constructor Create(aServerName: string);
|
|
destructor Destroy; override;
|
|
|
|
procedure CheckedFree; virtual;
|
|
|
|
property Engine: TnxBaseServerEngine
|
|
read becGetEngine;
|
|
end;
|
|
|
|
TNexusDBConnection = class(TDAConnectionWrapper)
|
|
protected {private}
|
|
conEngineContainer : TNexusDBBaseEngineContainer;
|
|
conEngineContainerNext : TNexusDBConnection;
|
|
conEngineContainerPrev : TNexusDBConnection;
|
|
conEngineContainerAdded : Boolean;
|
|
|
|
conSession : TnxSession;
|
|
conDatabase : TnxDatabase;
|
|
|
|
procedure conSetEngineContainer(aContainer: TNexusDBBaseEngineContainer);
|
|
protected
|
|
function GetConnected: Boolean; override;
|
|
procedure SetConnected(Value: Boolean); override;
|
|
|
|
procedure conAddToEngineContainer;
|
|
procedure conRemoveFromEngineContainer;
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
property EngineContainer: TNexusDBBaseEngineContainer read conEngineContainer write conSetEngineContainer;
|
|
property Session: TnxSession read conSession;
|
|
property Database: TnxDatabase read conDatabase;
|
|
end;
|
|
|
|
TDAENexusDBDriver = class(TDAEDriver, INexusDBDriver)
|
|
protected {private}
|
|
nxdEnginesPadlock: TnxPadlock;
|
|
nxdEngines: TStringList;
|
|
protected
|
|
function GetConnectionClass: TDAEConnectionClass; override;
|
|
|
|
{ IDADriver }
|
|
function GetDriverID: string; override;
|
|
function GetDescription: string; override;
|
|
|
|
procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
|
|
|
|
function GetAvailableDriverOptions: TDAAvailableDriverOptions; override;
|
|
function GetDefaultCustomParameters: string; override; safecall;
|
|
{ INexusDBDriver }
|
|
procedure RegisterServerEngine(aServerEngine: TnxBaseServerEngine;const aName: string); safecall;
|
|
|
|
procedure UnregisterServerEngine(aServerEngine: TnxBaseServerEngine); overload; safecall;
|
|
procedure UnregisterServerEngine(const aName: string); overload; safecall;
|
|
function GetDefaultConnectionType(const AuxDriver: string): string; override; safecall;
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TDAENexusDBConnection }
|
|
TDAENexusDBConnection = class(TDAEConnection, INexusDBConnection)
|
|
private
|
|
dacConnection: TNexusDBConnection;
|
|
protected
|
|
{ IDAConnection }
|
|
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;
|
|
|
|
procedure DoGetTableNames(out aList: IROStrings); override;
|
|
procedure DoGetStoredProcedureNames(out List: IROStrings); override;
|
|
procedure DoGetTableFields(const aTableName : string;
|
|
out aFields : TDAFieldCollection); override;
|
|
|
|
function DoGetLastAutoInc(const GeneratorName: string): integer; override;
|
|
public
|
|
end;
|
|
|
|
{ TDAENexusDBQuery }
|
|
TDAENexusDBQuery = class(TDAEDataset, IDAMustSetParams)
|
|
private
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataSet; override;
|
|
|
|
function DoExecute: Integer; override;
|
|
function DoGetSQL: string; override;
|
|
procedure DoSetSQL(const Value: string); override;
|
|
procedure DoPrepare(Value: Boolean); override;
|
|
|
|
{ IDAMustSetParams }
|
|
procedure SetParamValues(Params: TDAParamCollection); safecall;
|
|
procedure GetParamValues(Params: TDAParamCollection); safecall;
|
|
public
|
|
end;
|
|
|
|
{ TDAENexusStoredProcedure }
|
|
TDAENexusStoredProcedure = class(TDAEStoredProcedure, IDAStoredProcedure, IDAMustSetParams)
|
|
protected
|
|
// Internal
|
|
// function DoGetStoredProcedureName: string; override;
|
|
// procedure DoSetStoredProcedureName(const Name: string); override;
|
|
// procedure RefreshParams; override; safecall;
|
|
|
|
// IDAStoredProcedure
|
|
function GetStoredProcedureName: string; override; safecall;
|
|
procedure SetStoredProcedureName(const Name: string); override; safecall;
|
|
|
|
// procedure PrepareSQLStatement; override;
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
procedure DoPrepare(Value: boolean); override; safecall;
|
|
function Execute: integer; override; safecall;
|
|
procedure DoSetSQL(const Value: string); override; safecall;
|
|
function DoGetSQL: string; override; safecall;
|
|
// function intVCLTypeToDAType(aFieldType: TFieldType): TDADataType;override;
|
|
|
|
{ IDASQLCommand }
|
|
procedure RefreshParams; override; safecall;
|
|
// function DoGetRecordCount: integer; override;
|
|
// function DoGetActive: boolean; override;
|
|
// procedure DoSetActive(Value: boolean); override;
|
|
// function DoGetBOF: boolean; override;
|
|
// function DoGetEOF: boolean; override;
|
|
// procedure DoNext; override;
|
|
// function DoLocate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; override;
|
|
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(Params: TDAParamCollection); safecall;
|
|
procedure GetParamValues(Params: TDAParamCollection); safecall;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
function GetDriverObject: IDADriver; stdcall;
|
|
|
|
const
|
|
Nexus_DriverType = 'Nexus';
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
|
|
nxllUtils,nxsdTypes,
|
|
|
|
uDADriverManager,
|
|
uDARes,
|
|
uDAMacroProcessors,
|
|
|
|
TypInfo;
|
|
|
|
const
|
|
csUrlSeperator = '://';
|
|
|
|
csEmbedded = 'embedded';
|
|
csRegistered = 'registered';
|
|
csEmbeddedDefault = 'embedded://default';
|
|
|
|
csAlias = 'alias';
|
|
csPath = 'path';
|
|
|
|
csNexusDB = 'NexusDB';
|
|
csNexusDBDriver = 'NexusDB Driver';
|
|
|
|
resourcestring
|
|
rsEmbeddedOnly = ' [embedded only]';
|
|
rsThisDriverOnlySupportsEmbeddedServerEngines = 'This driver only supports embedded server engines. Connections to remote server engines require a full NexusDB license.';
|
|
rsNoProtocolHasBeenSpecified = 'No protocol has been specified';
|
|
rsNoServerEngineHasBeenRegisteredAs = 'No Server Engine has been registered as "%s"';
|
|
rsNoTransportAvailableForProtocol = 'No transport available for protocol "%s"';
|
|
rsUnknownDatabaseType = 'Unknown database type "%s"';
|
|
|
|
var
|
|
_driver : TDAENexusDBDriver = nil;
|
|
|
|
{===Register===================================================================}
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DAPalettePageName, [TDANexusDBDriver]);
|
|
end;
|
|
{==============================================================================}
|
|
|
|
|
|
|
|
{===GetDriverObject============================================================}
|
|
{$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 := TDAENexusDBDriver.Create(nil);
|
|
Result := _driver;
|
|
end;
|
|
{==============================================================================}
|
|
|
|
|
|
|
|
{===TNexusDBBaseEngineContainer================================================}
|
|
procedure TNexusDBBaseEngineContainer.CheckedFree;
|
|
begin
|
|
if not Assigned(becConnectionsHead) then
|
|
Free;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
constructor TNexusDBBaseEngineContainer.Create(aServerName: string);
|
|
begin
|
|
becServerName := aServerName;
|
|
|
|
inherited Create;
|
|
|
|
_driver.nxdEnginesPadlock.Lock;
|
|
try
|
|
_driver.nxdEngines.AddObject(aServerName, Self);
|
|
finally
|
|
_driver.nxdEnginesPadlock.Unlock;
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
destructor TNexusDBBaseEngineContainer.Destroy;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
if Assigned(_driver) then begin
|
|
_driver.nxdEnginesPadlock.Lock;
|
|
try
|
|
with _driver.nxdEngines do
|
|
if Find(becServerName, i) and (Objects[i] = Self) then
|
|
Delete(i);
|
|
while Assigned(becConnectionsHead) do try
|
|
becConnectionsHead.EngineContainer := nil;
|
|
except end;
|
|
finally
|
|
_driver.nxdEnginesPadlock.Unlock;
|
|
end;
|
|
end;
|
|
|
|
inherited;
|
|
end;
|
|
{==============================================================================}
|
|
|
|
|
|
|
|
{===TNexusDBEmbeddedEngineContainer============================================}
|
|
type
|
|
TNexusDBEmbeddedEngineContainer = class(TNexusDBBaseEngineContainer)
|
|
protected {private}
|
|
eecServerEngine: TnxServerEngine;
|
|
protected
|
|
function becGetEngine: TnxBaseServerEngine; override;
|
|
public
|
|
constructor Create(aServerName: string);
|
|
destructor Destroy; override;
|
|
|
|
procedure CheckedFree; override;
|
|
end;
|
|
function TNexusDBEmbeddedEngineContainer.becGetEngine: TnxBaseServerEngine;
|
|
begin
|
|
Result := eecServerEngine;
|
|
end;
|
|
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
|
|
procedure TNexusDBEmbeddedEngineContainer.CheckedFree;
|
|
begin
|
|
if not SameText(becServerName, csEmbeddedDefault) then
|
|
inherited;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
constructor TNexusDBEmbeddedEngineContainer.Create(aServerName: string);
|
|
begin
|
|
eecServerEngine := TnxServerEngine.Create(nil);
|
|
eecServerEngine.SqlEngine := TnxSqlEngine.Create(eecServerEngine);
|
|
eecServerEngine.Open;
|
|
|
|
inherited Create(aServerName);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
destructor TNexusDBEmbeddedEngineContainer.Destroy;
|
|
begin
|
|
inherited;
|
|
FreeAndNil(eecServerEngine);
|
|
end;
|
|
{==============================================================================}
|
|
|
|
|
|
|
|
{$IFNDEF DataAbstract_NexusDBPack}
|
|
{==============================================================================}
|
|
type
|
|
TNexusDBRemoteEngineContainer = class(TNexusDBBaseEngineContainer)
|
|
protected {private}
|
|
recTransport: TnxBaseTransport;
|
|
recServerEngine: TnxRemoteServerEngine;
|
|
protected
|
|
function becGetEngine: TnxBaseServerEngine; override;
|
|
public
|
|
constructor Create(aServerName, aAuxParamsString: string;
|
|
aTransportClass: TnxBaseTransportClass);
|
|
destructor Destroy; override;
|
|
end;
|
|
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
|
|
function TNexusDBRemoteEngineContainer.becGetEngine: TnxBaseServerEngine;
|
|
begin
|
|
Result := recServerEngine;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
constructor TNexusDBRemoteEngineContainer.Create(aServerName, aAuxParamsString: string;
|
|
aTransportClass: TnxBaseTransportClass);
|
|
var
|
|
S,
|
|
N,
|
|
V : string;
|
|
AuxParams : IROStrings;
|
|
i : integer;
|
|
|
|
procedure SetProperty(Instance: TObject; const Prefix, Name, Value: string);
|
|
begin
|
|
if (Pos(Prefix, Name) = 1) then
|
|
begin
|
|
SetPropValue(Instance,
|
|
Copy(Name, Length(Prefix) + 1, Length(Name)),
|
|
Value);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
S := aServerName;
|
|
Delete(S, 1, Pos(csUrlSeperator, S) + 2);
|
|
|
|
AuxParams := ListStringElements(aAuxParamsString);
|
|
|
|
recTransport := aTransportClass.Create(nil);
|
|
recTransport.ServerName := S;
|
|
|
|
recServerEngine := TnxRemoteServerEngine.Create(nil);
|
|
recServerEngine.Transport := recTransport;
|
|
|
|
for i := 0 to AuxParams.Count-1 do
|
|
begin
|
|
N := AuxParams.Names[i];
|
|
V := AuxParams.Values[AuxParams.Names[i]];
|
|
SetProperty(recTransport, 'Transport.', N, V);
|
|
SetProperty(recServerEngine, 'Server.', N, V);
|
|
end;
|
|
|
|
recTransport.Open;
|
|
recServerEngine.Open;
|
|
|
|
inherited Create(aServerName);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
destructor TNexusDBRemoteEngineContainer.Destroy;
|
|
begin
|
|
inherited;
|
|
FreeAndNil(recServerEngine);
|
|
FreeAndNil(recTransport);
|
|
end;
|
|
{==============================================================================}
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{===TNexusDBRegisteredEngineContainer==========================================}
|
|
type
|
|
TNexusDBRegisteredEngineContainer = class(TNexusDBBaseEngineContainer)
|
|
protected {private}
|
|
regecServerEngine: TnxBaseServerEngine;
|
|
protected
|
|
function becGetEngine: TnxBaseServerEngine; override;
|
|
public
|
|
constructor Create(aServerName: string;
|
|
aServerEngine: TnxBaseServerEngine);
|
|
|
|
procedure CheckedFree; override;
|
|
end;
|
|
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
|
|
function TNexusDBRegisteredEngineContainer.becGetEngine: TnxBaseServerEngine;
|
|
begin
|
|
Result := regecServerEngine;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TNexusDBRegisteredEngineContainer.CheckedFree;
|
|
begin
|
|
{never}
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
constructor TNexusDBRegisteredEngineContainer.Create(aServerName: string;
|
|
aServerEngine: TnxBaseServerEngine);
|
|
begin
|
|
regecServerEngine := aServerEngine;
|
|
inherited Create(aServerName);
|
|
end;
|
|
{==============================================================================}
|
|
|
|
|
|
|
|
{===TNexusDBConnection=========================================================}
|
|
procedure TNexusDBConnection.conAddToEngineContainer;
|
|
begin
|
|
if conEngineContainerAdded then
|
|
Exit;
|
|
if not Assigned(conEngineContainer) then
|
|
Exit;
|
|
|
|
_driver.nxdEnginesPadlock.Lock;
|
|
try
|
|
conEngineContainerPrev := conEngineContainer.becConnectionsTail;
|
|
conEngineContainer.becConnectionsTail := Self;
|
|
if Assigned(conEngineContainerPrev) then
|
|
conEngineContainerPrev.conEngineContainerNext := Self;
|
|
if not Assigned(conEngineContainer.becConnectionsHead) then
|
|
conEngineContainer.becConnectionsHead := Self;
|
|
finally
|
|
_driver.nxdEnginesPadlock.Unlock;
|
|
end;
|
|
|
|
conEngineContainerAdded := True;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TNexusDBConnection.conRemoveFromEngineContainer;
|
|
begin
|
|
if not conEngineContainerAdded then
|
|
Exit;
|
|
|
|
_driver.nxdEnginesPadlock.Lock;
|
|
try
|
|
if Assigned(conEngineContainerNext) then
|
|
conEngineContainerNext.conEngineContainerPrev := conEngineContainerPrev
|
|
else
|
|
if conEngineContainer.becConnectionsTail = Self then
|
|
conEngineContainer.becConnectionsTail := conEngineContainerPrev;
|
|
|
|
if Assigned(conEngineContainerPrev) then
|
|
conEngineContainerPrev.conEngineContainerNext := conEngineContainerNext
|
|
else
|
|
if conEngineContainer.becConnectionsHead = Self then
|
|
conEngineContainer.becConnectionsHead := conEngineContainerNext;
|
|
|
|
conEngineContainerNext := nil;
|
|
conEngineContainerPrev := nil;
|
|
|
|
conEngineContainer.CheckedFree;
|
|
conEngineContainer := nil;
|
|
finally
|
|
_driver.nxdEnginesPadlock.Unlock;
|
|
end;
|
|
conEngineContainerAdded := False;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TNexusDBConnection.conSetEngineContainer(aContainer: TNexusDBBaseEngineContainer);
|
|
begin
|
|
if conEngineContainer <> aContainer then begin
|
|
conSession.Close;
|
|
conSession.ServerEngine := nil;
|
|
|
|
conRemoveFromEngineContainer;
|
|
|
|
conEngineContainer := aContainer;
|
|
if Assigned(conEngineContainer) then
|
|
conSession.ServerEngine := conEngineContainer.Engine;
|
|
|
|
conAddToEngineContainer;
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
constructor TNexusDBConnection.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
conSession := TnxSession.Create(Self);
|
|
conDatabase := TnxDatabase.Create(Self);
|
|
conDatabase.Session := conSession;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
destructor TNexusDBConnection.Destroy;
|
|
begin
|
|
EngineContainer := nil;
|
|
inherited;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TNexusDBConnection.GetConnected: Boolean;
|
|
begin
|
|
Result := conDatabase.Connected;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TNexusDBConnection.SetConnected(Value: Boolean);
|
|
begin
|
|
if (csDestroying in ComponentState) then Exit;
|
|
|
|
try
|
|
conSession.Active := Value;
|
|
conDatabase.Connected := Value;
|
|
except
|
|
conSession.Active := False;
|
|
conDatabase.Connected := False;
|
|
raise;
|
|
end;
|
|
end;
|
|
{==============================================================================}
|
|
|
|
|
|
|
|
{===TDAENexusDBDriver==========================================================}
|
|
constructor TDAENexusDBDriver.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
nxdEnginesPadlock := TnxPadlock.Create;
|
|
nxdEngines := TStringList.Create;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
destructor TDAENexusDBDriver.Destroy;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
if Assigned(nxdEnginesPadlock) then begin
|
|
nxdEnginesPadlock.Lock;
|
|
try
|
|
if Assigned(nxdEngines) then begin
|
|
for i := Pred(nxdEngines.Count) downto 0 do
|
|
nxdEngines.Objects[i].Free;
|
|
nxdEngines.Clear;
|
|
end;
|
|
finally
|
|
nxdEnginesPadlock.Unlock;
|
|
end;
|
|
end;
|
|
inherited;
|
|
FreeAndNil(nxdEnginesPadlock);
|
|
FreeAndNil(nxdEngines);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBDriver.GetAuxParams(const AuxDriver: string; out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TDAENexusDBDriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
|
|
begin
|
|
{$IFDEF DataAbstract_NexusDBPack}
|
|
Result := [doDatabaseName];
|
|
{$ELSE}
|
|
Result := [doServerName, doDatabaseName, doLogin];
|
|
{$ENDIF}
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TDAENexusDBDriver.GetConnectionClass: TDAEConnectionClass;
|
|
begin
|
|
Result := TDAENexusDBConnection;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TDAENexusDBDriver.GetDefaultConnectionType(
|
|
const AuxDriver: string): string;
|
|
begin
|
|
Result:=Nexus_DriverType;
|
|
end;
|
|
|
|
function TDAENexusDBDriver.GetDefaultCustomParameters: string;
|
|
begin
|
|
Result:='';
|
|
end;
|
|
|
|
function TDAENexusDBDriver.GetDescription: string;
|
|
begin
|
|
Result := csNexusDBDriver
|
|
{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF}
|
|
{$IFDEF DataAbstract_NexusDBPack} + rsEmbeddedOnly{$ENDIF};
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TDAENexusDBDriver.GetDriverID: string;
|
|
begin
|
|
Result := csNexusDB;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBDriver.RegisterServerEngine(aServerEngine : TnxBaseServerEngine;
|
|
const aName : string);
|
|
begin
|
|
TNexusDBRegisteredEngineContainer.Create(csRegistered + csUrlSeperator + aName, aServerEngine);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBDriver.UnregisterServerEngine(aServerEngine : TnxBaseServerEngine);
|
|
var
|
|
i : Integer;
|
|
begin
|
|
_driver.nxdEnginesPadlock.Lock;
|
|
try
|
|
for i := Pred(_driver.nxdEngines.Count) downto 0 do
|
|
if _driver.nxdEngines.Objects[i] is TNexusDBRegisteredEngineContainer then
|
|
if TNexusDBRegisteredEngineContainer(_driver.nxdEngines.Objects[i]).regecServerEngine = aServerEngine then
|
|
_driver.nxdEngines.Objects[i].Free;
|
|
finally
|
|
_driver.nxdEnginesPadlock.Unlock;
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBDriver.UnregisterServerEngine(const aName : string);
|
|
var
|
|
i : Integer;
|
|
begin
|
|
_driver.nxdEnginesPadlock.Lock;
|
|
try
|
|
if _driver.nxdEngines.Find(csRegistered + csUrlSeperator + aName, i) then
|
|
_driver.nxdEngines.Objects[i].Free;
|
|
finally
|
|
_driver.nxdEnginesPadlock.Unlock;
|
|
end;
|
|
end;
|
|
{==============================================================================}
|
|
|
|
|
|
|
|
{===TDAENexusDBConnection======================================================}
|
|
function TDAENexusDBConnection.CreateCustomConnection: TCustomConnection;
|
|
begin
|
|
Result := TNexusDBConnection.Create(nil);
|
|
dacConnection := TNexusDBConnection(Result);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TDAENexusDBConnection.CreateMacroProcessor: TDASQLMacroProcessor;
|
|
begin
|
|
Result := TOracleMacroProcessor.Create;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBConnection.DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser;
|
|
aConnectionObject : TCustomConnection);
|
|
var
|
|
S, T : string;
|
|
i : Integer;
|
|
sl : TStringList;
|
|
tpc : TnxBaseTransportClass;
|
|
begin
|
|
inherited;
|
|
|
|
with aConnStrParser do begin
|
|
(aConnectionObject as TNexusDBConnection).Session.Close;
|
|
|
|
if Self.UserID <> '' then
|
|
dacConnection.Session.Username := Self.UserID
|
|
else
|
|
dacConnection.Session.Username := UserID;
|
|
|
|
if Self.Password <> '' then
|
|
dacConnection.Session.Password := Self.Password
|
|
else
|
|
dacConnection.Session.Password := Password;
|
|
|
|
Server := Trim(Server);
|
|
|
|
if Server = '' then
|
|
Server := csEmbeddedDefault;
|
|
|
|
_driver.nxdEnginesPadlock.Lock;
|
|
try
|
|
S := Server;
|
|
SetLength(S, nxMaxI32(0, Pred(Pos(csUrlSeperator, S))));
|
|
|
|
if S = '' then
|
|
raise EDADriverException.Create(rsNoProtocolHasBeenSpecified);
|
|
|
|
if not _driver.nxdEngines.Find(Server, i) then begin
|
|
|
|
if SameText(S, csEmbedded) then begin
|
|
(aConnectionObject as TNexusDBConnection).EngineContainer :=
|
|
TNexusDBEmbeddedEngineContainer.Create(Server);
|
|
end else if SameText(S, csRegistered) then begin
|
|
raise EDADriverException.CreateFmt(rsNoServerEngineHasBeenRegisteredAs, [Server]);
|
|
end else begin
|
|
{$IFDEF DataAbstract_NexusDBPack}
|
|
raise EDADriverException.Create(rsThisDriverOnlySupportsEmbeddedServerEngines);
|
|
{$ELSE}
|
|
sl := TStringList.Create;
|
|
try
|
|
TnxBaseDirectTransport.GetRegisteredClasses(sl);
|
|
tpc := nil;
|
|
for i := 0 to Pred(sl.Count) do
|
|
if SameText(S, TnxBaseTransportClass(sl.Objects[i]).ProtocolName) then begin
|
|
tpc := TnxBaseTransportClass(sl.Objects[i]);
|
|
Break;
|
|
end;
|
|
if not Assigned(tpc) then
|
|
raise EDADriverException.CreateFmt(rsNoTransportAvailableForProtocol, [S]);
|
|
(aConnectionObject as TNexusDBConnection).EngineContainer :=
|
|
TNexusDBRemoteEngineContainer.Create(Server, AuxParamsString, tpc);
|
|
finally
|
|
FreeAndNil(sl);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
end else
|
|
(aConnectionObject as TNexusDBConnection).EngineContainer :=
|
|
(_driver.nxdEngines.Objects[i] as TNexusDBBaseEngineContainer);
|
|
finally
|
|
_driver.nxdEnginesPadlock.Unlock;
|
|
end;
|
|
|
|
Database := Trim(Database);
|
|
|
|
S := Database;
|
|
SetLength(S, nxMaxI32(0, Pred(Pos(csUrlSeperator, S))));
|
|
if Pos(csUrlSeperator, Database) > 0 then
|
|
T := Copy(Database, Length(S) + 4, High(Integer))
|
|
else
|
|
T := Database;
|
|
|
|
if S = '' then
|
|
if (aConnectionObject as TNexusDBConnection).EngineContainer.becGetEngine is TnxServerEngine then
|
|
S := csPath
|
|
else
|
|
S := csAlias;
|
|
|
|
if SameText(S, csAlias) then
|
|
(aConnectionObject as TNexusDBConnection).Database.AliasName := T
|
|
else if SameText(S, csPath) then
|
|
(aConnectionObject as TNexusDBConnection).Database.AliasPath := T
|
|
else
|
|
raise EDADriverException.CreateFmt(rsUnknownDatabaseType, [S]);
|
|
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TDAENexusDBConnection.DoBeginTransaction: Integer;
|
|
begin
|
|
Result := -1;
|
|
dacConnection.Database.StartTransaction;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBConnection.DoCommitTransaction;
|
|
begin
|
|
dacConnection.Database.Commit;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TDAENexusDBConnection.DoGetInTransaction: Boolean;
|
|
begin
|
|
Result := dacConnection.Database.InTransaction;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBConnection.DoGetTableFields(const aTableName : string;
|
|
out aFields : TDAFieldCollection);
|
|
var
|
|
i : Integer;
|
|
begin
|
|
dacConnection.Open;
|
|
|
|
with TnxQuery.Create(nil) do try
|
|
SQL.Text := 'SELECT * FROM "' + aTableName + '" WHERE ''c'' <> ''c''';
|
|
Database := dacConnection.Database;
|
|
Open;
|
|
|
|
aFields := TDAFieldCollection.Create(nil);
|
|
try
|
|
for i := 0 to Pred(FieldCount) do
|
|
with aFields.Add do begin
|
|
Name := Fields.Fields[i].FieldName;
|
|
Size := Fields.Fields[i].Size;
|
|
Required := Fields.Fields[i].Required;
|
|
ReadOnly := Fields.Fields[i].ReadOnly;
|
|
Calculated := Fields.Fields[i].Calculated;
|
|
DisplayWidth := Fields.Fields[i].DisplayWidth;
|
|
DisplayLabel := Fields.Fields[i].DisplayLabel;
|
|
DataType := VCLTypeToDAType(Fields.Fields[i].DataType);
|
|
end;
|
|
except
|
|
FreeAndNil(aFields);
|
|
raise;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBConnection.DoGetTableNames(out aList: IROStrings);
|
|
begin
|
|
inherited;
|
|
dacConnection.Database.Open;
|
|
dacConnection.Database.GetTableNames(aList.Strings);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBConnection.DoRollbackTransaction;
|
|
begin
|
|
dacConnection.Database.Rollback;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TDAENexusDBConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
Result := TDAENexusDBQuery;
|
|
end;
|
|
|
|
function TDAENexusDBConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
Result:=TDAENexusStoredProcedure;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
function TDAENexusDBConnection.DoGetLastAutoInc(const GeneratorName: string): integer;
|
|
begin
|
|
// dacConnection.Database.GetAutoIncValue(GeneratorName, Cardinal(Result)); // NXDB2: Changed
|
|
dacConnection.Database.GetAutoIncValue(GeneratorName,
|
|
dacConnection.Session.Password,
|
|
Cardinal(Result));
|
|
Dec(Result);
|
|
end;
|
|
{==============================================================================}
|
|
|
|
|
|
|
|
{===TDAENexusDBQuery===========================================================}
|
|
function TDAENexusDBQuery.CreateDataset(aConnection: TDAEConnection): TDataSet;
|
|
begin
|
|
Result := TnxQuery.Create(nil);
|
|
with TnxQuery(Result) do begin
|
|
Database := TDAENexusDBConnection(aConnection).dacConnection.Database;
|
|
RequestLive := False;
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TDAENexusDBQuery.DoExecute: Integer;
|
|
begin
|
|
with TnxQuery(DataSet) do begin
|
|
ExecSQL;
|
|
Result := RowsAffected;
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TDAENexusDBQuery.DoGetSQL: string;
|
|
begin
|
|
Result := TnxQuery(DataSet).SQL.Text
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBQuery.DoPrepare(Value: Boolean);
|
|
begin
|
|
TnxQuery(DataSet).Prepared := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBQuery.DoSetSQL(const Value: string);
|
|
begin
|
|
TnxQuery(DataSet).SQL.Text := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TDAENexusDBQuery.SetParamValues(Params: TDAParamCollection);
|
|
var
|
|
i : Integer;
|
|
par : uDAInterfaces.TDAParam;
|
|
outpar : TParam;
|
|
begin
|
|
for i := 0 to (Params.Count - 1) do begin
|
|
par := Params[i];
|
|
outpar := TnxQuery(DataSet).Params.ParamByName(par.Name);
|
|
outpar.DataType := DATypeToVCLType(par.DataType);
|
|
outpar.ParamType := TParamType(Ord(par.ParamType));
|
|
outpar.Value := par.Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAENexusDBQuery.GetParamValues(Params: TDAParamCollection);
|
|
var
|
|
i: integer;
|
|
par: TDAParam;
|
|
inpar: TParam;
|
|
ds: TnxQuery;
|
|
begin
|
|
ds := TnxQuery(Dataset);
|
|
if not Assigned(ds.Params) then
|
|
Exit;
|
|
|
|
for i := 0 to (ds.Params.Count - 1) do begin
|
|
inpar := ds.Params[i];
|
|
|
|
par := Params.ParamByName(inpar.Name);
|
|
if par.ParamType in [daptOutput, daptInputOutput, daptResult] then
|
|
par.Value := inpar.Value;
|
|
end;
|
|
end;
|
|
|
|
|
|
{==============================================================================}
|
|
|
|
exports
|
|
GetDriverObject Name func_GetDriverObject;
|
|
|
|
procedure TDAENexusDBConnection.DoGetStoredProcedureNames(
|
|
out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
dacConnection.Database.Open;
|
|
dacConnection.Database.GetStoredProcNames(List.Strings);
|
|
end;
|
|
|
|
|
|
{ TDAENexusStoredProcedure }
|
|
|
|
function TDAENexusStoredProcedure.CreateDataset(
|
|
aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
Result := TnxStoredProc.Create(nil);
|
|
with TnxStoredProc(Result) do begin
|
|
Database := TDAENexusDBConnection(aConnection).dacConnection.Database;
|
|
RequestLive := False;
|
|
end;
|
|
end;
|
|
|
|
function TDAENexusStoredProcedure.Execute: integer;
|
|
begin
|
|
SetParamValues(GetParams);
|
|
TnxStoredProc(Dataset).ExecProc;
|
|
Result:=-1;
|
|
GetParamValues(GetParams);
|
|
end;
|
|
|
|
function TDAENexusStoredProcedure.DoGetSQL: string;
|
|
begin
|
|
Result:='';
|
|
end;
|
|
|
|
procedure TDAENexusStoredProcedure.DoSetSQL(const Value: string);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
procedure TDAENexusStoredProcedure.GetParamValues(
|
|
Params: TDAParamCollection);
|
|
var
|
|
i: integer;
|
|
par: TDAParam;
|
|
inpar: TParam;
|
|
ds: TnxStoredProc;
|
|
begin
|
|
ds := TnxStoredProc(Dataset);
|
|
if not Assigned(ds.Params) then Exit;
|
|
|
|
for i := 0 to (ds.Params.Count - 1) do begin
|
|
inpar := ds.Params[i];
|
|
par := Params.ParamByName(inpar.Name);
|
|
if par.ParamType in [daptOutput, daptInputOutput, daptResult] then
|
|
par.Value := inpar.Value;
|
|
end;
|
|
end;
|
|
|
|
function TDAENexusStoredProcedure.GetStoredProcedureName: string;
|
|
begin
|
|
Result:=TnxStoredProc(Dataset).StoredProcName;
|
|
end;
|
|
|
|
procedure TDAENexusStoredProcedure.SetParamValues(
|
|
Params: TDAParamCollection);
|
|
var
|
|
i : Integer;
|
|
par : uDAInterfaces.TDAParam;
|
|
outpar : TParam;
|
|
begin
|
|
for i := 0 to (Params.Count - 1) do begin
|
|
par := Params[i];
|
|
outpar := TnxStoredProc(DataSet).Params.ParamByName(par.Name);
|
|
outpar.DataType := DATypeToVCLType(par.DataType);
|
|
outpar.ParamType := TParamType(Ord(par.ParamType));
|
|
outpar.Value := par.Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAENexusStoredProcedure.SetStoredProcedureName(
|
|
const Name: string);
|
|
begin
|
|
TnxStoredProc(Dataset).StoredProcName:=Name;
|
|
end;
|
|
|
|
procedure TDAENexusStoredProcedure.RefreshParams;
|
|
begin
|
|
TnxStoredProc(DataSet).RefreshParam;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAENexusStoredProcedure.DoPrepare(Value: boolean);
|
|
begin
|
|
TnxStoredProc(DataSet).Prepared:=Value;
|
|
end;
|
|
|
|
|
|
initialization
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
try
|
|
_driver.Free;
|
|
except end;
|
|
_driver := nil;
|
|
end.
|
|
|
|
|