494 lines
14 KiB
ObjectPascal
494 lines
14 KiB
ObjectPascal
unit uDAIBXDriver;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Driver Library
|
|
{
|
|
{ compiler: Delphi 6 and up
|
|
{ platform: Win32
|
|
{
|
|
{ (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_IBXDriver_Glyphs.res}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, DB, uDAEngine, uDAInterfaces, uDAIBInterfaces, IBDatabase,
|
|
uROClasses, IBQuery, IBStoredProc, IBSQLMonitor, IB, uDAUtils;
|
|
|
|
type
|
|
{ TDAIBXDriver }
|
|
TDAIBXDriver = class(TDADriverReference)
|
|
end;
|
|
|
|
{ TIBXConnection }
|
|
TIBXConnection = class(TDAConnectionWrapper)
|
|
private
|
|
fDatabase: TIBDatabase;
|
|
fTransaction: TIBTransaction;
|
|
|
|
protected
|
|
function GetConnected: Boolean; override;
|
|
procedure SetConnected(Value: boolean); override;
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
|
|
property Database: TIBDatabase read fDatabase;
|
|
property Transaction: TIBTransaction read fTransaction;
|
|
end;
|
|
|
|
{ TDAEIBXDriver }
|
|
TDAEIBXDriver = class(TDAIBDriver)
|
|
private
|
|
fIBTraceOptions: TTraceFlags;
|
|
fTraceCallback: TDALogTraceEvent;
|
|
fMonitor: TIBSQLMonitor;
|
|
|
|
procedure OnIBXTrace(EventText: string; EventTime: TDateTime);
|
|
protected
|
|
function GetConnectionClass: TDAEConnectionClass; override;
|
|
procedure CustomizeConnectionObject(aConnection: TDAEConnection); override;
|
|
procedure DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent); override;
|
|
|
|
// IDADriver
|
|
function GetDriverID: string; override;
|
|
function GetDescription: string; override;
|
|
public
|
|
end;
|
|
|
|
{ TDAEIBXConnection }
|
|
TDAEIBXConnection = class(TDAIBConnection, IDAInterbaseConnection, IDAIBTransactionAccess, IDAIBConnectionProperties, IDAUseGenerators, IDAFileBasedDatabase)
|
|
private
|
|
fConnection: TIBXConnection;
|
|
|
|
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;
|
|
|
|
end;
|
|
|
|
{ TDAEIBXQuery }
|
|
TDAEIBXQuery = class(TDAEDataset)
|
|
|
|
protected
|
|
function DoGetRecordCount: integer; override;
|
|
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;
|
|
|
|
{ TDAEIBXStoredProcedure }
|
|
TDAEIBXStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
|
|
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, IBCustomDataSet, IBSQL,uROBinaryHelpers;
|
|
|
|
var
|
|
_driver: TDAEDriver = nil;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DAPalettePageName, [TDAIBXDriver]);
|
|
end;
|
|
|
|
function GetDriverObject: IDADriver;
|
|
begin
|
|
if (_driver = nil) then _driver := TDAEIBXDriver.Create(nil);
|
|
result := _driver;
|
|
end;
|
|
|
|
{ TIBXConnection }
|
|
|
|
constructor TIBXConnection.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
fDatabase := TIBDatabase.Create(Self);
|
|
fTransaction := TIBTransaction.Create(Self);
|
|
fTransaction.AutoStopAction := saNone;
|
|
//fTransaction.AutoStopAction := saCommit;
|
|
// ^ new per recommendation from Andy Gibson, to fix the "Transaction in progress" error.
|
|
|
|
fDatabase.LoginPrompt := FALSE;
|
|
fDatabase.DefaultTransaction := fTransaction;
|
|
end;
|
|
|
|
function TIBXConnection.GetConnected: Boolean;
|
|
begin
|
|
result := fDatabase.Connected
|
|
end;
|
|
|
|
procedure TIBXConnection.SetConnected(Value: boolean);
|
|
begin
|
|
// This first check is required.
|
|
// I think there's a bug in the IBX destroying sequence and the notification. TCustomConnection gets to this point *after*
|
|
// the owned components are destroyed. Only happens with IBX...
|
|
|
|
if (csDestroying in ComponentState) then Exit;
|
|
fDatabase.Connected := Value
|
|
end;
|
|
|
|
{ TDAEIBXConnection }
|
|
|
|
procedure TDAEIBXConnection.DoApplyConnectionString(
|
|
aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
|
|
begin
|
|
inherited;
|
|
|
|
with aConnStrParser do begin
|
|
if (Self.UserID <> '') then
|
|
fConnection.Database.Params.Add('user_name=' + Self.UserID)
|
|
else
|
|
fConnection.Database.Params.Add('user_name=' + UserID);
|
|
|
|
if (Self.Password <> '') then
|
|
fConnection.Database.Params.Add('password=' + Self.Password)
|
|
else
|
|
fConnection.Database.Params.Add('password=' + Password);
|
|
|
|
if Server <> '' then { Change: Aleksander Oven, 27. july 2003 }
|
|
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
|
|
SetCharset(AuxParams['Charset']);
|
|
|
|
end;
|
|
end;
|
|
|
|
function TDAEIBXConnection.DoBeginTransaction: integer;
|
|
begin
|
|
result := -1;
|
|
fConnection.Database.DefaultTransaction.StartTransaction;
|
|
end;
|
|
|
|
procedure TDAEIBXConnection.DoCommitTransaction;
|
|
begin
|
|
fConnection.Database.DefaultTransaction.Commit;
|
|
end;
|
|
|
|
function TDAEIBXConnection.CreateCustomConnection: TCustomConnection;
|
|
begin
|
|
fConnection := TIBXConnection.Create(nil);
|
|
result := fConnection;
|
|
end;
|
|
|
|
function TDAEIBXConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
result := TDAEIBXQuery
|
|
end;
|
|
|
|
function TDAEIBXConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
result := TDAEIBXStoredProcedure
|
|
end;
|
|
|
|
function TDAEIBXConnection.GetTransaction: TObject;
|
|
begin
|
|
result := fConnection.fTransaction;
|
|
end;
|
|
|
|
procedure TDAEIBXConnection.DoRollbackTransaction;
|
|
begin
|
|
fConnection.Database.DefaultTransaction.Rollback;
|
|
end;
|
|
|
|
function TDAEIBXConnection.GetRole: string;
|
|
begin
|
|
result := fConnection.Database.Params.Values['sql_role_name']
|
|
end;
|
|
|
|
function TDAEIBXConnection.GetSQLDialect: integer;
|
|
begin
|
|
result := fConnection.Database.SQLDialect
|
|
end;
|
|
|
|
function TDAEIBXConnection.GetCharset: string;
|
|
begin
|
|
result := fConnection.Database.Params.Values['lc_ctype']
|
|
end;
|
|
|
|
procedure TDAEIBXConnection.SetRole(const Value: string);
|
|
begin
|
|
fConnection.Database.Params.Values['sql_role_name'] := Value
|
|
end;
|
|
|
|
procedure TDAEIBXConnection.SetSQLDialect(Value: integer);
|
|
begin
|
|
fConnection.Database.SQLDialect := Value
|
|
end;
|
|
|
|
procedure TDAEIBXConnection.SetCharset(const Value: string);
|
|
begin
|
|
fConnection.Database.Params.Values['lc_ctype'] := Value;
|
|
end;
|
|
|
|
procedure TDAEIBXConnection.Commit;
|
|
begin
|
|
fConnection.fTransaction.Commit
|
|
end;
|
|
|
|
procedure TDAEIBXConnection.CommitRetaining;
|
|
begin
|
|
fConnection.fTransaction.CommitRetaining
|
|
end;
|
|
|
|
procedure TDAEIBXConnection.Rollback;
|
|
begin
|
|
fConnection.fTransaction.Rollback
|
|
end;
|
|
|
|
procedure TDAEIBXConnection.RollbackRetaining;
|
|
begin
|
|
fConnection.fTransaction.RollbackRetaining
|
|
end;
|
|
|
|
function TDAEIBXConnection.DoGetInTransaction: boolean;
|
|
begin
|
|
result := fConnection.fTransaction.InTransaction
|
|
end;
|
|
|
|
{ TDAEIBXDriver }
|
|
|
|
procedure TDAEIBXDriver.CustomizeConnectionObject(aConnection: TDAEConnection);
|
|
begin
|
|
TDAEIBXConnection(aConnection).fConnection.Database.TraceFlags := fIBTraceOptions;
|
|
end;
|
|
|
|
function TDAEIBXDriver.GetConnectionClass: TDAEConnectionClass;
|
|
begin
|
|
result := TDAEIBXConnection;
|
|
end;
|
|
|
|
function TDAEIBXDriver.GetDescription: string;
|
|
begin
|
|
result := 'Borland Interbase Express Driver';
|
|
end;
|
|
|
|
function TDAEIBXDriver.GetDriverID: string;
|
|
begin
|
|
result := 'IBX';
|
|
end;
|
|
|
|
procedure TDAEIBXDriver.OnIBXTrace(EventText: string; EventTime: TDateTime);
|
|
begin
|
|
if Assigned(fTraceCallback) then fTraceCallback(fMonitor, EventText, 0);
|
|
end;
|
|
|
|
procedure TDAEIBXDriver.DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent);
|
|
begin
|
|
inherited;
|
|
|
|
if TraceActive then begin
|
|
if (fMonitor = nil) then fMonitor := TIBSQLMonitor.Create(Self);
|
|
|
|
fMonitor.Enabled := FALSE;
|
|
fMonitor.OnSQL := OnIBXTrace;
|
|
|
|
fIBTraceOptions := [];
|
|
if (toPrepare in TraceOptions) then fIBTraceOptions := fIBTraceOptions + [tfQPrepare];
|
|
if (toExecute in TraceOptions) then fIBTraceOptions := fIBTraceOptions + [tfQExecute];
|
|
if (toFetch in TraceOptions) then fIBTraceOptions := fIBTraceOptions + [tfQFetch];
|
|
if (toError in TraceOptions) then fIBTraceOptions := fIBTraceOptions + [tfError];
|
|
if (toStmt in TraceOptions) then fIBTraceOptions := fIBTraceOptions + [tfStmt];
|
|
if (toConnect in TraceOptions) then fIBTraceOptions := fIBTraceOptions + [tfConnect];
|
|
if (toTransact in TraceOptions) then fIBTraceOptions := fIBTraceOptions + [tfTransact];
|
|
if (toBlob in TraceOptions) then fIBTraceOptions := fIBTraceOptions + [tfBlob];
|
|
if (toService in TraceOptions) then fIBTraceOptions := fIBTraceOptions + [tfService];
|
|
if (toMisc in TraceOptions) then fIBTraceOptions := fIBTraceOptions + [tfMisc];
|
|
|
|
fTraceCallBack := Callback;
|
|
|
|
fMonitor.TraceFlags := fIBTraceOptions;
|
|
fMonitor.Enabled := TRUE;
|
|
end
|
|
else begin
|
|
FreeAndNIL(fMonitor);
|
|
fTraceCallback := nil;
|
|
end;
|
|
end;
|
|
|
|
{ TDAEIBXQuery }
|
|
|
|
function TDAEIBXQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TIBQuery.Create(nil);
|
|
TIBQuery(result).UniDirectional := true;
|
|
TIBQuery(result).Database := TDAEIBXConnection(aConnection).fConnection.Database;
|
|
end;
|
|
|
|
function TDAEIBXQuery.DoExecute: integer;
|
|
begin
|
|
inherited DoExecute;
|
|
|
|
result := TIBQuery(Dataset).RowsAffected;
|
|
end;
|
|
|
|
function TDAEIBXQuery.DoGetRecordCount: integer;
|
|
begin
|
|
TIBQuery(Dataset).FetchAll;
|
|
Result := inherited DoGetRecordCount;
|
|
end;
|
|
|
|
function TDAEIBXQuery.DoGetSQL: string;
|
|
begin
|
|
result := TIBQuery(Dataset).SQL.Text
|
|
end;
|
|
|
|
procedure TDAEIBXQuery.DoPrepare(Value: boolean);
|
|
begin
|
|
TIBQuery(Dataset).Prepared := Value
|
|
end;
|
|
|
|
procedure TDAEIBXQuery.DoSetSQL(const Value: string);
|
|
begin
|
|
TIBQuery(Dataset).SQL.Text := Value;
|
|
end;
|
|
|
|
|
|
{ TDAEIBXStoredProcedure }
|
|
|
|
function TDAEIBXStoredProcedure.CreateDataset(
|
|
aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TIBStoredProc.Create(nil);
|
|
TIBStoredProc(result).Database := TDAEIBXConnection(aConnection).fConnection.Database;
|
|
end;
|
|
|
|
function TDAEIBXStoredProcedure.Execute: integer;
|
|
begin
|
|
SetParamValues(GetParams);
|
|
TIBStoredProc(Dataset).ExecProc;
|
|
result := TIBStoredProc(Dataset).RowsAffected;
|
|
GetParamValues(GetParams);
|
|
end;
|
|
|
|
procedure TDAEIBXStoredProcedure.SetParamValues(Params: TDAParamCollection); safecall;
|
|
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 := TIBStoredProc(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 TDAEIBXStoredProcedure.GetParamValues(Params: TDAParamCollection); safecall;
|
|
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 := TIBStoredProc(Dataset).ParamByName(Params[i].Name);
|
|
params[i].Value := sqPar.Value
|
|
end;
|
|
end;
|
|
|
|
function TDAEIBXStoredProcedure.GetStoredProcedureName: string;
|
|
begin
|
|
result := TIBStoredProc(Dataset).StoredProcName
|
|
end;
|
|
|
|
procedure TDAEIBXStoredProcedure.SetStoredProcedureName(
|
|
const Name: string);
|
|
begin
|
|
TIBStoredProc(Dataset).StoredProcName := Name;
|
|
end;
|
|
|
|
procedure TDAEIBXStoredProcedure.RefreshParams;
|
|
begin
|
|
// Apparently a bug in IBX requires to do so... Automatic gathering only works at runtime
|
|
TIBStoredProc(Dataset).Prepare;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
exports
|
|
GetDriverObject name func_GetDriverObject;
|
|
|
|
initialization
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
FreeAndNIL(_driver);
|
|
|
|
end.
|