Componentes.Terceros.RemObjects/official/5.0.23.613/Data Abstract for Delphi/Source/Drivers/uDAIBXDriver.pas

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.