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.