unit uDAFIBDriver;

{----------------------------------------------------------------------------}
{ 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_FIBDriver_Glyphs.res}

interface

uses
  Classes, DB, uDAEngine, uDAInterfaces, uDAIBInterfaces, FIBDatabase,
  uROClasses, pFIBDatabase, FIBQuery, pFIBQuery, pFIBStoredProc, uDAUtils,
  FIBDataSet, ibase, FIBSQLMonitor;

type
  { TDAFIBDriver }
  TDAFIBDriver = class(TDADriverReference)
  end;

  { TFIBConnection }
  TFIBConnection = class(TDAConnectionWrapper)
  private
    fDatabase: TpFIBDatabase;
    fTransaction: TFIBTransaction;

  protected
    function GetConnected: Boolean; override;
    procedure SetConnected(Value: boolean); override;

  public
    constructor Create(AOwner: TComponent); override;

    property Database: TpFIBDatabase read fDatabase;
    property Transaction: TFIBTransaction read fTransaction;
  end;

  { TDAEFIBDriver }
  TDAEFIBDriver = class(TDAIBDriver)
  private
    fFIBTraceOptions: TFIBTraceFlags;
    fTraceCallback: TDALogTraceEvent;
    fMonitor: TFIBSQLMonitor;
    procedure OnTrace(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;

  { TDAEFIBConnection }
  TDAEFIBConnection = class(TDAIBConnection, IDAInterbaseConnection, IDAIBTransactionAccess, IDAIBConnectionProperties, IDAUseGenerators, IDAFileBasedDatabase)
  private
    fConnection: TFIBConnection;
  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;

  { TDAEFIBQuery }
  TDAEFIBQuery = class(TDAEDataset, IDAMustSetParams)
  private
  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;
    procedure RefreshParams; override;
    procedure DoSetActive(Value: Boolean); override;
    procedure SetParamValues(Params: TDAParamCollection); safecall;
    procedure GetParamValues(Params: TDAParamCollection); safecall;
  public
  end;

  { TDAEFIBStoredProcedure }
  TDAEFIBStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
  private
    FSP: TpFIBStoredProc;
  protected
    function CreateDataset(aConnection: TDAEConnection): TDataset; override;

    function GetStoredProcedureName: string; override;
    procedure SetStoredProcedureName(const Name: string); override;
    procedure RefreshParams; 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, 
  pFIBProps;

var
  _driver: TDAEDriver = nil;

procedure Register;
begin
  RegisterComponents(DAPalettePageName, [TDAFIBDriver]);
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 := TDAEFIBDriver.Create(nil);
  result := _driver;
end;


{ TFIBConnection }

constructor TFIBConnection.Create(AOwner: TComponent);
begin
  inherited;

  fDatabase := TpFIBDatabase.Create(Self);
  fTransaction := TFIBTransaction.Create(Self);

  fDatabase.UseLoginPrompt := FALSE;
  fDatabase.DefaultTransaction := fTransaction;
end;

function TFIBConnection.GetConnected: Boolean;
begin
  result := fDatabase.Connected
end;

procedure TFIBConnection.SetConnected(Value: boolean);
begin
  // This first check is required.
  // I think there's a bug in the FIB destroying sequence and the notification. TCustomConnection gets to this point *after*
  // the owned components are destroyed. Only happens with FIB...

  if (csDestroying in ComponentState) then Exit;
  fDatabase.Connected := Value
end;

{ TDAEFIBConnection }

procedure TDAEFIBConnection.DoApplyConnectionString(
  aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
begin
  inherited;

  fConnection.Database.SQLDialect := 3;
  with aConnStrParser do begin
    if (Self.UserID <> '') then
      fConnection.Database.ConnectParams.UserName := Self.UserID
    else
      fConnection.Database.ConnectParams.UserName := UserID;

    if (Self.Password <> '') then
      fConnection.Database.ConnectParams.Password := Self.Password
    else
      fConnection.Database.ConnectParams.Password := Password;

    if Server <> '' then 
      fConnection.Database.DatabaseName := Server + ':' + Database
    else
      fConnection.Database.DatabaseName := Database;

    if AuxParams['Dialect'] <> '' then
      fConnection.Database.SQLDialect := StrtoInt(AuxParams['Dialect'])
    else if AuxParams['SQLDialect'] <> '' then
      fConnection.Database.SQLDialect := StrtoInt(AuxParams['SQLDialect']);

    if AuxParams['Role'] <> '' then
      fConnection.Database.ConnectParams.RoleName := AuxParams['Role'];

    if AuxParams['Charset'] <> '' then
      SetCharset(AuxParams['Charset']);

  end;
end;

function TDAEFIBConnection.DoBeginTransaction: integer;
begin
  result := -1;
  fConnection.Database.DefaultTransaction.StartTransaction;
end;

procedure TDAEFIBConnection.DoCommitTransaction;
begin
  fConnection.Database.DefaultTransaction.Commit;
end;

function TDAEFIBConnection.CreateCustomConnection: TCustomConnection;
begin
  fConnection := TFIBConnection.Create(nil);
  result := fConnection;
end;

function TDAEFIBConnection.GetDatasetClass: TDAEDatasetClass;
begin
  result := TDAEFIBQuery
end;

function TDAEFIBConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
begin
  result := TDAEFIBStoredProcedure
end;

function TDAEFIBConnection.GetTransaction: TObject;
begin
  result := fConnection.fTransaction;
end;

procedure TDAEFIBConnection.DoRollbackTransaction;
begin
  fConnection.Database.DefaultTransaction.Rollback;
end;

function TDAEFIBConnection.GetRole: string;
begin
  result := fConnection.Database.ConnectParams.RoleName;
end;

function TDAEFIBConnection.GetSQLDialect: integer;
begin
  result := fConnection.Database.SQLDialect
end;

function TDAEFIBConnection.GetCharset: string;
begin
  result := fConnection.Database.ConnectParams.CharSet
end;

procedure TDAEFIBConnection.SetRole(const Value: string);
begin
  fConnection.Database.ConnectParams.RoleName := Value
end;

procedure TDAEFIBConnection.SetSQLDialect(Value: integer);
begin
  fConnection.Database.SQLDialect := Value
end;

procedure TDAEFIBConnection.SetCharset(const Value: string);
begin
  fConnection.Database.ConnectParams.CharSet := Value;
end;

procedure TDAEFIBConnection.Commit;
begin
  fConnection.fTransaction.Commit
end;

procedure TDAEFIBConnection.CommitRetaining;
begin
  fConnection.fTransaction.CommitRetaining
end;

procedure TDAEFIBConnection.Rollback;
begin
  fConnection.fTransaction.Rollback
end;

procedure TDAEFIBConnection.RollbackRetaining;
begin
  fConnection.fTransaction.RollbackRetaining
end;

function TDAEFIBConnection.DoGetInTransaction: boolean;
begin
  result := fConnection.fTransaction.InTransaction
end;

{ TDAEFIBDriver }

procedure TDAEFIBDriver.CustomizeConnectionObject(aConnection: TDAEConnection);
begin
  // 25/04/06 13:05 Donald Shimoda . To do.
  //TDAEFIBConnection(aConnection).fConnection.Database.TraceFlags := fIBTraceOptions;
end;

procedure TDAEFIBDriver.DoSetTraceOptions(TraceActive: boolean;
  TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent);
begin
  inherited;

  if TraceActive then begin
    if (fMonitor = nil) then fMonitor := TFIBSQLMonitor.Create(Self);

    fMonitor.Active := False;
    fMonitor.OnSQL := OnTrace;

    fFIBTraceOptions := [];
    if (toPrepare in TraceOptions) then fFIBTraceOptions := fFIBTraceOptions + [tfQPrepare];
    if (toExecute in TraceOptions) then fFIBTraceOptions := fFIBTraceOptions + [tfQExecute];
    if (toFetch in TraceOptions) then fFIBTraceOptions := fFIBTraceOptions + [tfQFetch];
    if (toConnect in TraceOptions) then fFIBTraceOptions := fFIBTraceOptions + [tfConnect];
    if (toTransact in TraceOptions) then fFIBTraceOptions := fFIBTraceOptions + [tfTransact];
    if (toService in TraceOptions) then fFIBTraceOptions := fFIBTraceOptions + [tfService];
    if (toMisc in TraceOptions) then fFIBTraceOptions := fFIBTraceOptions + [tfMisc];

    fTraceCallBack := Callback;

    fMonitor.TraceFlags := fFIBTraceOptions;
    fMonitor.Active := True;
  end
  else begin
    FreeAndNIL(fMonitor);
    fTraceCallback := nil;
  end;
end;


function TDAEFIBDriver.GetConnectionClass: TDAEConnectionClass;
begin
  result := TDAEFIBConnection;
end;

function TDAEFIBDriver.GetDescription: string;
begin
  result := 'FIBPlus Driver'{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF};
end;

function TDAEFIBDriver.GetDriverID: string;
begin
  result := 'FIB';
end;

procedure CreateParams(FQuery: TFIBQuery; Pars: TDAParamCollection; CreateOutputParams: Boolean = False);
var
  i: Integer;
  par: TDAParam;
  sqPar: TFIBXSQLVAR;
begin
  if FQuery.Database.Handle = nil then
    FQuery.Database.Open;

  if not FQuery.Prepared then
    FQuery.Prepare;
  pars.Clear;
  for i := 0 to FQuery.ParamCount -1 do begin
    sqpar := FQuery.Params[i];
    if sqpar.IsParam then begin
      par := pars.Add;
      par.Name := sqPar.Name;
      par.ParamType:= daptInput;
      case sqpar.SQLType and not 1 of
        SQL_VARYING, SQL_TEXT:
        begin
          if sqPar.CharacterSet = 'UNICODE_FSS' then
            par.DataType := datWideString
          else
            par.DataType := datString;
          par.Size := sqPar.Size;
        end;
        SQL_DOUBLE, SQL_FLOAT,SQL_D_FLOAT:par.DataType := datFloat;
        SQL_SHORT, SQL_LONG: begin
         if sqPar.Scale <> 0 then
           par.DataType := datFloat
         else
           par.DataType := datInteger;
        end;
        SQL_INT64: begin
         if sqPar.Scale <> 0 then
           par.DataType := datFloat
         else
           par.DataType := datLargeInt;
        end;
        SQL_TIMESTAMP,
        SQL_TYPE_TIME,
        SQL_TYPE_DATE: par.DataType := datDateTime;
        SQL_BLOB:
          if sqPar.SQLSubtype = 1 then
             par.DataType := datMemo
          else
             par.DataType := datBlob;
        SQL_BOOLEAN: par.DataType := datBoolean;
      else
          par.DataType := datUnknown;
      end;
    end;
  end;

  if CreateOutputParams then
    for i := 0 to FQuery.FieldCount -1 do begin
      sqpar := FQuery.Fields[i];
      par := pars.Add;
      par.Name := sqPar.Name;
      par.ParamType:= daptOutput;
      case sqpar.SQLType and not 1 of
        SQL_VARYING, SQL_TEXT:
        begin
          if sqPar.CharacterSet = 'UNICODE_FSS' then
            par.DataType := datWideString
          else
            par.DataType := datString;
          par.Size := sqPar.Size;
        end;
        SQL_DOUBLE, SQL_FLOAT,SQL_D_FLOAT:par.DataType := datFloat;
        SQL_SHORT, SQL_LONG: begin
         if sqPar.Scale <> 0 then
           par.DataType := datFloat
         else
           par.DataType := datInteger;
        end;
        SQL_INT64: begin
         if sqPar.Scale <> 0 then
           par.DataType := datFloat
         else
           par.DataType := datLargeInt;
        end;
        SQL_TIMESTAMP,
        SQL_TYPE_TIME,
        SQL_TYPE_DATE: par.DataType := datDateTime;
        SQL_BLOB:
          if sqPar.SQLSubtype = 1 then
             par.DataType := datMemo
          else
             par.DataType := datBlob;
        SQL_BOOLEAN: par.DataType := datBoolean;
      else
          par.DataType := datUnknown;
      end;
    end;
end;


{ TDAEFIBQuery }


procedure TDAEFIBDriver.OnTrace(EventText: string; EventTime: TDateTime);
begin
  if Assigned(fTraceCallback) then fTraceCallback(fMonitor, EventText, 0);
end;

{ TDAEFIBStoredProcedure }

function TDAEFIBStoredProcedure.CreateDataset(
  aConnection: TDAEConnection): TDataset;
begin
  FreeAndNil(FSP);
  FSP := TpFIBStoredProc.Create(nil);
  FSP.Database := TDAEFIBConnection(aConnection).fConnection.Database;
  result := nil;
end;

function TDAEFIBStoredProcedure.Execute: integer;
begin
  if not TDAEFIBConnection(Connection).fConnection.Connected then TDAEFIBConnection(Connection).fConnection.Open;
  if not TDAEFIBConnection(Connection).fConnection.Transaction.InTransaction then
    TDAEFIBConnection(Connection).fConnection.Transaction.StartTransaction;
  if FSP.Database.Handle = nil then
    FSP.Database.Open;

    SetParamValues(GetParams);
    FSP.ExecQuery;
    result := FSP.RowsAffected;
    GetParamValues(GetParams);
end;

procedure TDAEFIBStoredProcedure.SetParamValues(Params: TDAParamCollection);
var
  i: integer;
  _params: TDAParamCollection;
  sqPar: TFIBXSQLVAR;
begin
  _params := Params;

  for i := 0 to _params.Count - 1 do begin
    if (_Params[i].ParamType in [daptInput, daptInputOutput, daptUnknown]) then begin
     sqPar:= FSP.ParamByName(_Params[i].Name);
     if (sqPar <> nil) and sqPar.IsParam then sqPar.Value:=_params[i].Value;
    end;
  end;
end;

procedure TDAEFIBStoredProcedure.GetParamValues(Params: TDAParamCollection);
var
  i: integer;
  _params: TDAParamCollection;
  sqPar: TFIBXSQLVAR;
begin
  _params := Params;

  for i := 0 to _params.Count - 1 do begin
    if (Params[i].ParamType in [daptOutput, daptInputOutput, daptResult]) then begin
     sqPar:= FSP.FieldByName(_Params[i].Name);
     if (sqPar <> nil) then _params[i].Value:=sqPar.Value;
    end;
  end;  
end;


function TDAEFIBStoredProcedure.GetStoredProcedureName: string;
begin
  result := FSP.StoredProcName;
end;

procedure TDAEFIBStoredProcedure.SetStoredProcedureName(
  const Name: string);
begin
  if not TDAEFIBConnection(Connection).fConnection.Connected then TDAEFIBConnection(Connection).fConnection.Open;
  if not TDAEFIBConnection(Connection).fConnection.Transaction.InTransaction then
    TDAEFIBConnection(Connection).fConnection.Transaction.StartTransaction;
  FSP.StoredProcName := Name;
end;

procedure TDAEFIBStoredProcedure.RefreshParams;
begin
  if not TDAEFIBConnection(Connection).fConnection.Connected then TDAEFIBConnection(Connection).fConnection.Open;
  if not TDAEFIBConnection(Connection).fConnection.Transaction.InTransaction then
    TDAEFIBConnection(Connection).fConnection.Transaction.StartTransaction;
  CreateParams(FSP, GetParams,True);
end;

exports
  GetDriverObject name func_GetDriverObject;

{ TDAEFIBQuery }

function TDAEFIBQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
var
  ds: TFIBDataSet;
begin
  ds := TFIBDataSet.Create(nil);
  ds.Database := TDAEFIBConnection(aConnection).fConnection.Database;
  ds.Transaction := TDAEFIBConnection(aConnection).fConnection.Transaction;
  ds.PrepareOptions := ds.PrepareOptions + [psUseLargeIntField];
  result := ds;
end;

function TDAEFIBQuery.DoExecute: integer;
begin
  if not TDAEFIBConnection(Connection).fConnection.Connected then TDAEFIBConnection(Connection).fConnection.Open;
  if not TDAEFIBConnection(Connection).fConnection.Transaction.InTransaction then
    TDAEFIBConnection(Connection).fConnection.Transaction.StartTransaction;
  TFIBDataSet(Dataset).QSelect.ExecQuery;
  result := TFIBDataSet(Dataset).QSelect.RowsAffected;
end;

function TDAEFIBQuery.DoGetRecordCount: integer;
begin
  result := TFIBDataSet(DAtaset).QSelect.RecordCount;
end;

function TDAEFIBQuery.DoGetSQL: string;
begin
  result := TFIBDataSet(DAtaset).QSelect.SQL.Text;
end;

procedure TDAEFIBQuery.DoPrepare(Value: boolean);
begin
  if not TDAEFIBConnection(Connection).fConnection.Connected then TDAEFIBConnection(Connection).fConnection.Open;
  if not TDAEFIBConnection(Connection).fConnection.Transaction.InTransaction then
    TDAEFIBConnection(Connection).fConnection.Transaction.StartTransaction;

  if Value then TFIBDataSet(DAtaset).QSelect.Prepare;
end;

procedure TDAEFIBQuery.DoSetActive(Value: Boolean);
begin
  if not TDAEFIBConnection(Connection).fConnection.Connected then TDAEFIBConnection(Connection).fConnection.Open;
  if not TDAEFIBConnection(Connection).fConnection.Transaction.InTransaction then
    TDAEFIBConnection(Connection).fConnection.Transaction.StartTransaction;
  if Value then begin
    if not TFIBDataSet(Dataset).Database.Connected then
      TFIBDataSet(Dataset).Database.Connected := true;
  end;
  inherited DoSetActive(Value);
end;

procedure TDAEFIBQuery.DoSetSQL(const Value: string);
begin
  TFIBDataSet(DAtaset).QSelect.SQL.Text := Value;
end;



procedure TDAEFIBQuery.RefreshParams;
begin
  CreateParams(TFIBDataSet(Dataset).QSelect, GetParams);
end;


procedure TDAEFIBQuery.SetParamValues(Params: TDAParamCollection);
var
  i: integer;
  _params: TDAParamCollection;
  _par: TDAParam;
begin
  _params := GetParams;

  for i := 0 to TFIBDataSet(Dataset).ParamCount - 1 do begin
    _Par := _params.ParamByName(TFIBDataSet(Dataset).Params[i].Name);
    if (_Par.ParamType in [daptInput, daptInputOutput, daptUnknown]) then
      if (TFIBDataSet(Dataset).Params[i].IsParam) then TFIBDataSet(Dataset).Params[i].Value := _Par.Value;
  end;
end;

procedure TDAEFIBQuery.GetParamValues(Params: TDAParamCollection);
var
  i: integer;
  _params: TDAParamCollection;
  _Par: TDAParam;
begin
  _params := GetParams;
  for i := 0 to TFIBDataSet(Dataset).ParamCount - 1 do begin
    _Par := _params.ParamByName(TFIBDataSet(Dataset).Params[i].Name);
     if (_Par.ParamType in [daptOutput, daptInputOutput, daptResult]) then
      _Par.Value := TFIBDataSet(Dataset).Params[i].Value;
  end;
end;


initialization
  _driver := nil;
  RegisterDriverProc(GetDriverObject);

finalization
  UnregisterDriverProc(GetDriverObject);
  FreeAndNIL(_driver);

end.