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
519 lines
14 KiB
ObjectPascal
519 lines
14 KiB
ObjectPascal
unit uDAIBODriver;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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.
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I ..\DataAbstract.inc}
|
|
|
|
{$R DataAbstract_IBODriver_Glyphs.res}
|
|
|
|
interface
|
|
|
|
uses DB, Classes, uDAEngine, uDAInterfaces, uDAIBInterfaces, uROClasses,
|
|
IBODataset, IB_Components, IB_Monitor, uDAUtils;
|
|
|
|
type
|
|
{ TDAIBODriver }
|
|
TDAIBODriver = class(TDADriverReference)
|
|
end;
|
|
|
|
{ TIBOConnection }
|
|
TIBOConnection = class(TDAConnectionWrapper)
|
|
private
|
|
fDatabase: TIBODatabase;
|
|
|
|
protected
|
|
function GetConnected: Boolean; override;
|
|
procedure SetConnected(Value: boolean); override;
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
property Database: TIBODatabase read fDatabase;
|
|
end;
|
|
|
|
{ TDAEIBODriver }
|
|
TDAEIBODriver = class(TDAIBDriver)
|
|
private
|
|
fTraceCallback: TDALogTraceEvent;
|
|
fMonitor: TIB_Monitor;
|
|
procedure OnIBOTrace(Sender: TObject; const NewString: string);
|
|
protected
|
|
function GetConnectionClass: TDAEConnectionClass; override;
|
|
|
|
// IDADriver
|
|
function GetDriverID: string; override;
|
|
function GetDescription: string; override;
|
|
|
|
procedure DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions;
|
|
Callback: TDALogTraceEvent); override;
|
|
|
|
public
|
|
end;
|
|
|
|
{ TDAEIBOConnection }
|
|
TDAEIBOConnection = class(TDAIBConnection, IDAInterbaseConnection, IDAIBTransactionAccess, IDAIBConnectionProperties, IDAUseGenerators,
|
|
IDAFileBasedDatabase)
|
|
private
|
|
fConnection: TIBOConnection;
|
|
fSQLDialect: integer; // See TDAEIBOConnection.GetSQLDialect for more details
|
|
|
|
protected
|
|
|
|
// IIBTransactionAccess
|
|
function GetTransaction: TObject; safecall;
|
|
|
|
procedure Commit; safecall;
|
|
procedure CommitRetaining; safecall;
|
|
procedure Rollback; safecall;
|
|
procedure RollbackRetaining; safecall;
|
|
|
|
// IIBConnectionProperties
|
|
function GetRole: string; safecall;
|
|
procedure SetRole(const Value: string); safecall;
|
|
function GetSQLDialect: integer; override;safecall;
|
|
procedure SetSQLDialect(Value: integer); safecall;
|
|
function GetCharset: string; safecall;
|
|
procedure SetCharset(const Value: string); safecall;
|
|
|
|
// IDAConnection
|
|
function CreateCustomConnection: TCustomConnection; override;
|
|
|
|
function GetDatasetClass: TDAEDatasetClass; override;
|
|
function GetStoredProcedureClass: TDAEStoredProcedureClass; override;
|
|
|
|
procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser;
|
|
aConnectionObject: TCustomConnection); override;
|
|
|
|
function DoBeginTransaction: integer; override;
|
|
procedure DoCommitTransaction; override;
|
|
procedure DoRollbackTransaction; override;
|
|
function DoGetInTransaction: boolean; override;
|
|
public
|
|
end;
|
|
|
|
{ TDAEIBOQuery }
|
|
TDAEIBOQuery = class(TDAEDataset)
|
|
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;
|
|
|
|
public
|
|
end;
|
|
|
|
{ TDAEIBOStoredProcedure }
|
|
TDAEIBOStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
|
|
private
|
|
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
procedure RefreshParams; 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;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
function GetDriverObject: IDADriver; stdcall;
|
|
|
|
implementation
|
|
|
|
uses SysUtils, uDADriverManager, uDARes, uROBinaryHelpers;
|
|
|
|
var
|
|
_driver: TDAEDriver = nil;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DAPalettePageName, [TDAIBODriver]);
|
|
end;
|
|
|
|
{$IFDEF DataAbstract_SchemaModelerOnly}
|
|
{$INCLUDE ..\DataAbstract_SchemaModelerOnly.inc}
|
|
{$ENDIF DataAbstract_SchemaModelerOnly}
|
|
|
|
function GetDriverObject: IDADriver;
|
|
begin
|
|
{$IFDEF DataAbstract_SchemaModelerOnly}
|
|
if not RunningInSchemaModeler then begin
|
|
result := nil;
|
|
exit;
|
|
end;
|
|
{$ENDIF}
|
|
if (_driver = nil) then _driver := TDAEIBODriver.Create(nil);
|
|
result := _driver;
|
|
end;
|
|
|
|
|
|
|
|
{ TIBOConnection }
|
|
|
|
constructor TIBOConnection.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
fDatabase := TIBODatabase.Create(Self);
|
|
fDatabase.LoginPrompt := FALSE;
|
|
end;
|
|
|
|
destructor TIBOConnection.Destroy;
|
|
begin
|
|
FreeAndNil(fDatabase);
|
|
inherited;
|
|
end;
|
|
|
|
function TIBOConnection.GetConnected: Boolean;
|
|
begin
|
|
result := fDatabase.Connected
|
|
end;
|
|
|
|
procedure TIBOConnection.SetConnected(Value: boolean);
|
|
begin
|
|
if fDatabase <> nil then fDatabase.Connected := Value;
|
|
end;
|
|
|
|
{ TDAEIBOConnection }
|
|
|
|
procedure TDAEIBOConnection.DoApplyConnectionString(
|
|
aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
|
|
begin
|
|
inherited;
|
|
|
|
with aConnStrParser do begin
|
|
if (Self.UserID <> '') then
|
|
fConnection.Database.Username := Self.UserID
|
|
else
|
|
fConnection.Database.Username := UserID;
|
|
|
|
if (Self.Password <> '') then
|
|
fConnection.Database.Password := Self.Password
|
|
else
|
|
fConnection.Database.Password := Password;
|
|
|
|
if (Server <> '') then
|
|
fConnection.Database.DatabaseName := Server + ':' + Database
|
|
else
|
|
fConnection.Database.DatabaseName := Database;
|
|
|
|
if AuxParams['Dialect'] <> '' then
|
|
SetSQLDialect(StrToInt(AuxParams['Dialect']))
|
|
else if AuxParams['SQLDialect'] <> '' then
|
|
SetSQLDialect(StrToInt(AuxParams['SQLDialect']));
|
|
|
|
if AuxParams['Role'] <> '' then
|
|
SetRole(AuxParams['Role']);
|
|
|
|
if AuxParams['Charset'] <> '' then
|
|
fConnection.Database.CharSet := AuxParams['Charset'];
|
|
|
|
end;
|
|
end;
|
|
|
|
function TDAEIBOConnection.DoBeginTransaction: integer;
|
|
begin
|
|
fConnection.Database.DefaultTransaction.StartTransaction;
|
|
result := -1;
|
|
end;
|
|
|
|
procedure TDAEIBOConnection.DoCommitTransaction;
|
|
begin
|
|
fConnection.Database.DefaultTransaction.Commit;
|
|
end;
|
|
|
|
function TDAEIBOConnection.CreateCustomConnection: TCustomConnection;
|
|
begin
|
|
fConnection := TIBOConnection.Create(nil);
|
|
fSQLDialect := fConnection.Database.SQLDialect;
|
|
result := fConnection;
|
|
end;
|
|
|
|
function TDAEIBOConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
result := TDAEIBOQuery
|
|
end;
|
|
|
|
function TDAEIBOConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
result := TDAEIBOStoredProcedure
|
|
end;
|
|
|
|
function TDAEIBOConnection.GetTransaction: TObject;
|
|
begin
|
|
result := fConnection.Database.DefaultTransaction;
|
|
end;
|
|
|
|
procedure TDAEIBOConnection.DoRollbackTransaction;
|
|
begin
|
|
fConnection.Database.DefaultTransaction.Rollback;
|
|
end;
|
|
|
|
function TDAEIBOConnection.GetRole: string;
|
|
begin
|
|
result := fConnection.Database.SQLRole
|
|
end;
|
|
|
|
function TDAEIBOConnection.GetSQLDialect: integer;
|
|
begin
|
|
// AleF: I modified this because somehow IBO returned 3 even after setting this value to 2 or else.
|
|
// Somewhere in the IBO code this calue gets reset. This is a work around that basically makes QuoteIdentifier work correctly
|
|
|
|
result := fSQLDialect; // fConnection.Database.SQLDialect;
|
|
end;
|
|
|
|
procedure TDAEIBOConnection.SetSQLDialect(Value: integer);
|
|
begin
|
|
fSQLDialect := Value;
|
|
fConnection.Database.SQLDialect := Value;
|
|
end;
|
|
|
|
procedure TDAEIBOConnection.SetRole(const Value: string);
|
|
begin
|
|
fConnection.Database.SQLRole := Value
|
|
end;
|
|
|
|
procedure TDAEIBOConnection.Commit;
|
|
begin
|
|
fConnection.Database.Commit
|
|
end;
|
|
|
|
procedure TDAEIBOConnection.CommitRetaining;
|
|
begin
|
|
fConnection.Database.CommitRetaining
|
|
end;
|
|
|
|
procedure TDAEIBOConnection.Rollback;
|
|
begin
|
|
fConnection.Database.Rollback
|
|
end;
|
|
|
|
procedure TDAEIBOConnection.RollbackRetaining;
|
|
begin
|
|
fConnection.Database.RollbackRetaining
|
|
end;
|
|
|
|
function TDAEIBOConnection.DoGetInTransaction: boolean;
|
|
begin
|
|
result := fConnection.Database.InTransaction
|
|
end;
|
|
|
|
function TDAEIBOConnection.GetCharset: string;
|
|
begin
|
|
result := fConnection.Database.CharSet;
|
|
end;
|
|
|
|
procedure TDAEIBOConnection.SetCharset(const Value: string);
|
|
begin
|
|
fConnection.Database.CharSet := Value;
|
|
end;
|
|
|
|
{ TDAEIBODriver }
|
|
|
|
function TDAEIBODriver.GetConnectionClass: TDAEConnectionClass;
|
|
begin
|
|
result := TDAEIBOConnection
|
|
end;
|
|
|
|
function TDAEIBODriver.GetDescription: string;
|
|
begin
|
|
result := 'Interbase Objects (IBO) Driver';
|
|
end;
|
|
|
|
function TDAEIBODriver.GetDriverID: string;
|
|
begin
|
|
result := 'IBO';
|
|
end;
|
|
|
|
procedure TDAEIBODriver.OnIBOTrace(Sender: TObject; const NewString: string);
|
|
begin
|
|
if Assigned(fTraceCallback) then fTraceCallback(fMonitor, NewString, 0);
|
|
end;
|
|
|
|
procedure TDAEIBODriver.DoSetTraceOptions(TraceActive: boolean; TraceOptions:
|
|
TDATraceOptions; Callback: TDALogTraceEvent);
|
|
begin
|
|
inherited;
|
|
|
|
if TraceActive then begin
|
|
if (fMonitor = nil) then fMonitor := TIB_Monitor.Create(Self);
|
|
|
|
fMonitor.Enabled := FALSE;
|
|
fMonitor.OnMonitorOutputItem := OnIBOTrace;
|
|
fMonitor.IncludeTimeStamp := True;
|
|
fMonitor.ItemStart := '';
|
|
fMonitor.ItemEnd := '';
|
|
fMonitor.NewLineText := ',';
|
|
|
|
FMonitor.MonitorGroups := [];
|
|
FMonitor.StatementGroups := [];
|
|
|
|
if (toPrepare in TraceOptions) then begin
|
|
FMonitor.MonitorGroups := FMonitor.MonitorGroups + [mgStatement];
|
|
FMonitor.StatementGroups := FMonitor.StatementGroups + [sgPrepare, sgAllocate, sgStatementInfo, sgDescribe];
|
|
end;
|
|
|
|
if (toExecute in TraceOptions) then begin
|
|
FMonitor.MonitorGroups := FMonitor.MonitorGroups + [mgStatement];
|
|
FMonitor.StatementGroups := FMonitor.StatementGroups + [sgExecute];
|
|
end;
|
|
|
|
if (toFetch in TraceOptions) then begin
|
|
FMonitor.MonitorGroups := FMonitor.MonitorGroups + [mgStatement, mgRow];
|
|
FMonitor.StatementGroups := FMonitor.StatementGroups + [sgDescribe, sgStatementInfo];
|
|
end;
|
|
|
|
if (toStmt in TraceOptions) then begin
|
|
FMonitor.MonitorGroups := FMonitor.MonitorGroups + [mgStatement];
|
|
FMonitor.StatementGroups := FMonitor.StatementGroups + [sgDescribe, sgStatementInfo];
|
|
end;
|
|
|
|
if (toConnect in TraceOptions) then FMonitor.MonitorGroups := FMonitor.MonitorGroups + [mgConnection];
|
|
if (toTransact in TraceOptions) then FMonitor.MonitorGroups := FMonitor.MonitorGroups + [mgtransaction];
|
|
|
|
if (toBlob in TraceOptions) then FMonitor.MonitorGroups := FMonitor.MonitorGroups + [mgBlob];
|
|
|
|
if (toMisc in TraceOptions) then begin
|
|
FMonitor.MonitorGroups := FMonitor.MonitorGroups + [mgBlob, mgArray, mgClientTrace];
|
|
FMonitor.StatementGroups := FMonitor.StatementGroups + [sgStatementInfo, sgServerCursor, sgServerCursor];
|
|
end;
|
|
|
|
fTraceCallBack := Callback;
|
|
|
|
fMonitor.Enabled := TRUE;
|
|
end
|
|
else begin
|
|
FreeAndNIL(fMonitor);
|
|
fTraceCallback := nil;
|
|
end;
|
|
end;
|
|
|
|
{ TDAEIBOQuery }
|
|
|
|
function TDAEIBOQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TIBOQuery.Create(nil);
|
|
TIBOQuery(result).IB_Connection := TDAEIBOConnection(aConnection).fConnection.Database;
|
|
TIBOQuery(result).AutoFetchAll := TRUE;
|
|
TIBOQuery(result).RecordCountAccurate := TRUE;
|
|
end;
|
|
|
|
function TDAEIBOQuery.DoExecute: integer;
|
|
begin
|
|
inherited DoExecute;
|
|
result := TIBOQuery(Dataset).RowsAffected;
|
|
end;
|
|
|
|
function TDAEIBOQuery.DoGetSQL: string;
|
|
begin
|
|
result := TIBOQuery(Dataset).SQL.Text
|
|
end;
|
|
|
|
procedure TDAEIBOQuery.DoPrepare(Value: boolean);
|
|
begin
|
|
TIBOQuery(Dataset).Prepared := Value;
|
|
end;
|
|
|
|
procedure TDAEIBOQuery.DoSetSQL(const Value: string);
|
|
begin
|
|
TIBOQuery(Dataset).SQL.Text := Value;
|
|
end;
|
|
|
|
{ TDAEIBOStoredProcedure }
|
|
|
|
function TDAEIBOStoredProcedure.CreateDataset(
|
|
aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TIBOStoredProc.Create(nil);
|
|
TIBOStoredProc(result).IB_Connection := TDAEIBOConnection(aConnection).fConnection.Database;
|
|
end;
|
|
|
|
function TDAEIBOStoredProcedure.Execute: integer;
|
|
begin
|
|
with TIBOStoredProc(Dataset) do begin
|
|
Unprepare;
|
|
Prepare;
|
|
end;
|
|
|
|
SetParamValues(GetParams);
|
|
TIBOStoredProc(Dataset).ExecProc;
|
|
result := TIBOStoredProc(Dataset).RowsAffected;
|
|
GetParamValues(GetParams);
|
|
end;
|
|
|
|
function TDAEIBOStoredProcedure.GetStoredProcedureName: string;
|
|
begin
|
|
result := TIBOStoredProc(Dataset).StoredProcName;
|
|
end;
|
|
|
|
procedure TDAEIBOStoredProcedure.SetStoredProcedureName(
|
|
const Name: string);
|
|
begin
|
|
TIBOStoredProc(Dataset).StoredProcName := Name;
|
|
end;
|
|
|
|
procedure TDAEIBOStoredProcedure.RefreshParams;
|
|
begin
|
|
// Apparently a bug in IBO requires to do so... Automatic gathering only works at runtime
|
|
TIBOStoredProc(Dataset).Prepare;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDAEIBOStoredProcedure.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 := TIBOStoredProc(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 TDAEIBOStoredProcedure.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 := TIBOStoredProc(Dataset).ParamByName(Params[i].Name);
|
|
params[i].Value := sqPar.Value
|
|
end;
|
|
end;
|
|
|
|
exports
|
|
GetDriverObject name func_GetDriverObject;
|
|
|
|
initialization
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
FreeAndNIL(_driver);
|
|
|
|
end.
|