unit uDAODACDriver;

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

{$I ..\DataAbstract.inc}

{$R DataAbstract_ODACDriver_Glyphs.res}

{
  If you have the version with source code, uncomment the following conditional to
  make this unit compile.
}

{.$DEFINE SOURCECODEVERSION}

interface

uses DB, Classes, uDAEngine, uDAInterfaces, uDAADOInterfaces, uROClasses, Variants,
  uDAOracleInterfaces, Ora, DBAccess, DASQLMonitor, OraSQLMonitor, OraSmart, uDAMacroProcessors, uDAUtils, OraClasses;

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

     { TDAEODACDriver }
  TDAEODACDriver = class(TDAOracleDriver)
  private
    fMonitor: TOraSQLMonitor;
    fTraceCallBack: TDALogTraceEvent;

    procedure OnODACTrace(Sender: TObject; Text: string; Flag: TDATraceFlag);

  protected
    function GetConnectionClass: TDAEConnectionClass; override;

       // IDADriver
    function GetDriverID: string; override;
    function GetDescription: string; override;
    procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;

    procedure DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent); override;

    function GetAvailableDriverOptions: TDAAvailableDriverOptions; override;
    function GetDefaultCustomParameters: string; override;

  public
  end;

     { TDAEODACConnection }
  TDAEODACConnection = class(TDAOracleConnection)
  private
    fConnection: TORASession;
  protected
    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
    function GetDatabaseNames: IROStrings;
  end;

     { TDAEODACQuery }
  TDAEODACQuery = class(TDAEDataset, IDAOracleDataset, IDAMustSetParams)
  private

  protected
    function CreateDataset(aConnection: TDAEConnection): TDataset; override;
    function intVCLTypeToDAType(aFieldType: TFieldType): TDADataType;override;
    procedure ClearParams; override;
       // IDADataset
    function DoExecute: integer; override;
    function DoGetSQL: string; override;
    procedure DoSetSQL(const Value: string); override;
    procedure DoPrepare(Value: boolean); override;
    procedure DoSetActive(Value: boolean); override;

       // IOracleDataset
    function GetLockMode: TDAOracleLockMode;
    procedure SetLockMode(Value: TDAOracleLockMode);
    function GetOptions: TDAOracleOptions;
    procedure SetOptions(Value: TDAOracleOptions);

       // IDAMustSetParams
    procedure SetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
  public
  end;

     { TDAEODACStoredProcedure }
  TDAEODACStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
  protected
    function CreateDataset(aConnection: TDAEConnection): TDataset; override;
    function intVCLTypeToDAType(aFieldType: TFieldType): TDADataType;override;

    function GetStoredProcedureName: string; override;
    procedure SetStoredProcedureName(const Name: string); override;
    procedure RefreshParams; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    function DoExecute: integer; override;
    function Execute: integer; override;

        // IDAMustSetParams
    procedure SetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
    procedure GetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
  end;

procedure Register;

function GetDriverObject: IDADriver; stdcall;

implementation

uses
  SysUtils,
  uDADriverManager, uDARes, uROBinaryHelpers;

var
  _driver: TDAEDriver = nil;

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


procedure ReadODACParamValues(AParams: TDAParamCollection;aDACParams: TOraParams;pvSession: TOraSession);
var
  i: integer;
  lParam: TOraParam;
  ms: IROStream;
begin
  for i := 0 to aDACParams.Count - 1 do begin
    lParam := aDACParams[i];
    if (lParam.ParamType in [ptOutput, ptInputOutput, ptResult]) then
      if ord(lParam.DataType) = ftBFile then begin
        ms := TROStream.Create;
        lParam.AsBFile.SaveToStream(ms.Stream);
        ms.Position:=0;
        Aparams.ParamByName(lParam.Name).LoadFromStream(ms);
        ms:=nil;
      end
      else
        Aparams.ParamByName(lParam.Name).Value := lParam.Value;
  end;
end;


procedure WriteODACParamValues(InputParams: TDAParamCollection;OutputParams: TOraParams;pvSession: TOraSession);
var i : integer;
    par : uDAInterfaces.TDAParam;
    outpar : TOraParam;
    ms: IROStream;
    blobtype : TFieldType;
    lvOraLob : TOralob;
begin
  for i := 0 to (InputParams.Count-1) do begin
    par := InputParams[i];
    outpar := OutputParams.ParamByName(par.Name);

    // If no blob type is specified, then gets the default field type.
    // BlobType is only meaningful to Oracle. MSSQL works fine just setting the DataType
    blobtype := BlobTypeMappings[par.BlobType];
    if (blobtype=ftUnknown) then blobtype := DADataTypesMappings[par.DataType];

    case par.DataType of
      datBlob : begin
        outpar.ParamType := TParamType(par.ParamType);
        outpar.DataType := DADataTypesMappings[par.DataType];
        if par.ParamType <> daptOutput then begin
          ms := TROStream.Create;
          par.SaveToStream(ms);
          ms.Position := 0;
          lvOraLob := TOralob.Create(pvSession.OCISvcCtx);
          try
            lvOraLob.CreateTemporary(ltBlob);
            if ms.Size>0 then lvOraLob.LoadFromStream(ms.Stream);
            lvOraLob.WriteLob;
            outpar.AsOraBLOB := lvOraLob;
          finally
            lvOraLob.Free;
          end;
        end;

      end;
      datMemo : begin
        outpar.ParamType := TParamType(par.ParamType);
        outpar.DataType := ftMemo;

        // Only happens with Oracle
        if (blobtype<>ftUnknown) then outpar.DataType := blobtype;
        if par.ParamType <> daptOutput then outpar.Value := par.Value;
      end;
      else begin
        outpar.ParamType := TParamType(par.ParamType);
        case par.DataType of
          datAutoInc : outpar.DataType := ftInteger;
          datLargeAutoInc: outpar.DataType := ftLargeInt;
        else
          outpar.DataType := DADataTypesMappings[par.DataType];
        end;
        if par.ParamType <> daptOutput then outpar.Value := par.Value;
      end;
    end;
  end;
end;

{ TDAEODACConnection }

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

  with aConnStrParser do begin

    if (Self.UserID <> '') then
      fConnection.Username := Self.UserID
    else
      fConnection.Username := UserID;

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

    fConnection.Server := Server;
    fConnection.ConnectPrompt := FALSE;
    fConnection.Debug := (AuxParams['Debug']='1');

    fConnection.Options.Net := AuxParams['Net'] = '1';
  end;
end;

function TDAEODACConnection.DoBeginTransaction: integer;
begin
  fConnection.StartTransaction;
  result := 0;
end;

procedure TDAEODACConnection.DoCommitTransaction;
begin
  fConnection.Commit;
end;

function TDAEODACConnection.CreateCustomConnection: TCustomConnection;
begin
  fConnection := TORASession.Create(nil);
  fConnection.LoginPrompt := FALSE;

  { ToDo: add a COnnectionString parameter to set
    fConnection.Debug := TRUE; }

  result := fConnection;
end;

function TDAEODACConnection.GetDatasetClass: TDAEDatasetClass;
begin
  result := TDAEODACQuery;
end;

function TDAEODACConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
begin
  result := TDAEODACStoredProcedure;
end;

procedure TDAEODACConnection.DoRollbackTransaction;
begin
  fConnection.Rollback;
end;

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

function TDAEODACConnection.GetDatabaseNames: IROStrings;
begin
  Result := TROStrings.Create();
  fConnection.GetDatabaseNames(Result.Strings);
end;


{ TDAEODACDriver }

function TDAEODACDriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
begin
  result := [doServerName, doLogin, doCustom];
end;

function TDAEODACDriver.GetConnectionClass: TDAEConnectionClass;
begin
  result := TDAEODACConnection;
end;

function TDAEODACDriver.GetDefaultCustomParameters: string;
begin
  result := 'Net=0';
end;

function TDAEODACDriver.GetDescription: string;
begin
  result := 'Core Lab ODAC Driver'{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF};
end;

function TDAEODACDriver.GetDriverID: string;
begin
  result := 'ODAC';
end;

procedure TDAEODACDriver.GetAuxParams(const AuxDriver: string; out List: IROStrings);
begin
  inherited;
  List.Add('Net=0,1');
end;

procedure TDAEODACDriver.OnODACTrace(Sender: TObject; Text: string; Flag: TDATraceFlag);
begin
  if Assigned(fTraceCallback) then fTraceCallback(Sender, Text, integer(Flag));
end;

procedure TDAEODACDriver.DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent);
var
  sdacopts: TDATraceFlags;
begin
  inherited;

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

    fMonitor.Active := FALSE;
    fMonitor.OnSQL := OnODACTrace;

    sdacopts := [];
    if (toPrepare in TraceOptions) then sdacopts := sdacopts + [tfQPrepare];
    if (toExecute in TraceOptions) then sdacopts := sdacopts + [tfQExecute];
    if (toFetch in TraceOptions) then sdacopts := sdacopts + [tfQFetch];
    if (toError in TraceOptions) then sdacopts := sdacopts + [tfError];
    if (toStmt in TraceOptions) then sdacopts := sdacopts + [tfStmt];
    if (toConnect in TraceOptions) then sdacopts := sdacopts + [tfConnect];
    if (toTransact in TraceOptions) then sdacopts := sdacopts + [tfTransact];
    if (toBlob in TraceOptions) then sdacopts := sdacopts + [tfBlob];
    if (toService in TraceOptions) then sdacopts := sdacopts + [tfService];
    if (toMisc in TraceOptions) then sdacopts := sdacopts + [tfMisc];
    if (toParams in TraceOptions) then sdacopts := sdacopts + [tfParams];

    fTraceCallBack := Callback;

    fMonitor.TraceFlags := sdacopts;
    fMonitor.Active := TRUE;
  end
  else begin
    FreeAndNIL(fMonitor);
    fTraceCallback := nil;
  end;
end;

{ TDAEODACQuery }

function TDAEODACQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
begin
  result := TSmartQuery.Create(nil);
  TSmartQuery(result).Debug := TDAEODACConnection(aConnection).fConnection.Debug;
  TSmartQuery(result).ReadOnly := TRUE;
  TSmartQuery(result).FetchAll := True; //for preventing creating an additional session when you call StartTransaction (an known issue of OLEDB)
  TSmartQuery(result).Unidirectional := True;
  TSmartQuery(result).Session := TDAEODACConnection(aConnection).fConnection;
end;

function TDAEODACQuery.DoGetSQL: string;
begin
  result := TSmartQuery(Dataset).SQL.Text;
end;

procedure TDAEODACQuery.DoSetSQL(const Value: string);
begin
  TSmartQuery(Dataset).SQL.Text := Value;
end;

function TDAEODACQuery.GetLockMode: TDAOracleLockMode;
begin
  result := TDAOracleLockMode(TSmartQuery(Dataset).LockMode)
end;

procedure TDAEODACQuery.SetLockMode(Value: TDAOracleLockMode);
begin
  TSmartQuery(Dataset).LockMode := TLockMode(Value)
end;

procedure TDAEODACQuery.SetOptions(Value: TDAOracleOptions);
var
  {$IFDEF SOURCECODEVERSION}
  dsopts: TOraDataSetOptions;
  {$ELSE}
  dsopts: TOraDataSetOptionsDS;
  {$ENDIF}
begin
  {$IFDEF SOURCECODEVERSION}
  dsopts := TSmartQuery(Dataset).Options;
  {$ELSE}
  dsopts := TSmartQuery(Dataset).OptionsDS;
  {$ENDIF}
  
  TSmartQuery(Dataset).DMLRefresh := True; // To get the output params when we exec SPs
  dsopts.AutoClose := opAutoClose in Value;
  dsopts.DefaultValues := opDefaultValues in Value;
  dsopts.LongStrings := opLongStrings in Value;
  dsopts.QueryRecCount := opQueryRecCount in Value;
  dsopts.CacheLobs := opCacheLobs in Value;
  dsopts.DeferredLobRead := opDeferredLobRead in Value;
  dsopts.KeepPrepared := opKeepPrepared in Value;
end;

function TDAEODACQuery.GetOptions: TDAOracleOptions;
var
  {$IFDEF SOURCECODEVERSION}
  dsopts: TOraDataSetOptions;
  {$ELSE}
  dsopts: TOraDataSetOptionsDS;
  {$ENDIF}
begin
  {$IFDEF SOURCECODEVERSION}
  dsopts := TSmartQuery(Dataset).Options;
  {$ELSE}
  dsopts := TSmartQuery(Dataset).OptionsDS;
  {$ENDIF}

  result := [];

  if dsopts.AutoClose then result := result + [opAutoClose];
  if dsopts.DefaultValues then result := result + [opDefaultValues];
  if dsopts.LongStrings then result := result + [opLongStrings];
  if dsopts.QueryRecCount then result := result + [opQueryRecCount];
  if dsopts.CacheLobs then result := result + [opCacheLobs];
  if dsopts.DeferredLobRead then result := result + [opDeferredLobRead];
  if dsopts.KeepPrepared then result := result + [opKeepPrepared];
end;

procedure TDAEODACQuery.DoPrepare(Value: boolean);
begin
  TSmartQuery(Dataset).Prepared := Value
end;

function TDAEODACQuery.DoExecute: integer;
begin
  TSmartQuery(Dataset).ExecSQL;
  result := TSmartQuery(Dataset).RowsAffected;
end;

procedure TDAEODACQuery.SetParamValues(AParams: TDAParamCollection);
begin
  WriteODACParamValues(AParams, TSmartQuery(Dataset).Params, TSmartQuery(Dataset).Session);
end;

procedure TDAEODACQuery.GetParamValues(AParams: TDAParamCollection);
begin
  ReadODACParamValues(AParams, TSmartQuery(Dataset).Params, TSmartQuery(Dataset).Session)
end;


function ExtractTableName(aSQLStatement: string): string;
var sql: string;
    idx, i, x: integer;
begin
  result := '';

  sql := UpperCase(aSQLStatement);
  ReplaceChar(sql, [#13, #9, #10], #32);

  idx := Pos(' FROM ', sql);
  if (idx=0) then Exit;

  for i := idx+6 to Length(sql) do begin
    if (sql[i]<>#32) then begin
      for x := i to Length(sql) do
        if not (sql[x] in ['A'..'Z', '0'..'9', '.', '_']) then begin
          result := Trim(Copy(sql, i, x-i));
          Exit;
        end;
    end;
  end;
end;

procedure TDAEODACQuery.DoSetActive(Value: boolean);
var willCreateFields: boolean;
    fieldColl: TDAFieldCollection;
    tableName: string;
    fld: TDAField;
    qry: TSmartQuery;
begin
  fieldColl:=nil; // prevent warnings
  willCreateFields := FALSE;
  if Value then begin
    fieldColl := inherited GetFields;
    willCreateFields := fieldColl.Count=0;
  end;

  inherited;

  if not willCreateFields then Exit;

  { Determines which ones are part of the PK }
  tableName := UpperCase(ExtractTableName(DoGetSQL));

  if (tableName='') then Exit;
  qry := TSmartQuery.Create(NIL);
  try
    qry.Assign(Dataset);
    qry.SQL.Text := Format(
       'SELECT cols.column_name, cols.position '+
       'FROM all_constraints cons, all_cons_columns cols '+
       'WHERE cols.table_name = ''%s'' AND cons.constraint_type = ''P'' AND cons.constraint_name = cols.constraint_name '+
       'AND cons.owner = cols.owner ORDER BY cols.position', [tableName]);
    qry.Open;
    if (qry.RecordCount=0) then Exit;

    while not qry.Eof do try
      fld := fieldColl.FindField(qry.Fields[0].AsString);
      if (fld<>NIL) then begin
        fld.InPrimaryKey := TRUE;
        fld.Required := TRUE;
      end;
    finally
      qry.Next;
    end;
  finally
    qry.Free;
  end;
end;

function TDAEODACQuery.intVCLTypeToDAType(
  aFieldType: TFieldType): TDADataType;
begin
  if ord(aFieldType) in [ftTimeStampTZ,ftTimeStampLTZ] then aFieldType:=ftTimeStamp;
  if ord(aFieldType) in [ftBFile] then aFieldType:=ftBlob;
  Result:= inherited intVCLTypeToDAType(aFieldType);
end;

procedure TDAEODACQuery.ClearParams;
begin
  inherited;
  TSmartQuery(Dataset).Params.Clear;
end;

{ TDAEODACStoredProcedure }

function TDAEODACStoredProcedure.CreateDataset(aConnection: TDAEConnection): TDataset;
begin
  result := TOraStoredProc.Create(nil);
  TOraStoredProc(result).Debug := TDAEODACConnection(aConnection).fConnection.Debug;
  TOraStoredProc(result).Session := TDAEODACConnection(aConnection).fConnection;
end;

function TDAEODACStoredProcedure.Execute: integer;
var
//  i: integer;
  _params: TDAParamCollection;
 // lParam: DBAccess.TDAParam;
begin
  _params := GetParams;
  setParamValues(_Params);
{
  with TOraStoredProc(Dataset) do begin
    if (Params.Count <> _Params.Count) then TOraStoredProc(Dataset).PrepareSQL;

    for i := 0 to (Params.Count - 1) do
      if (Params[i].ParamType in [ptInput, ptInputOutput]) then
        Params[i].Value := _params.ParamByName(Params[i].Name).Value;

    for i := 0 to (_params.Count - 1) do begin
      lParam := Params.ParamByName(_params[i].Name);
      if (_params[i].DataType = datString) and (_params[i].Size > 4000) and (lParam.ParamType in [ptOutput, ptInputOutput]) then
        lParam.Size := _params[i].Size;
    end;
  end;
}
  result := DoExecute;
  GetParamValues(_Params);
end;

function TDAEODACStoredProcedure.GetStoredProcedureName: string;
begin
  result := TOraStoredProc(Dataset).StoredProcName;
end;

procedure TDAEODACStoredProcedure.SetStoredProcedureName(
  const Name: string);
begin
  TOraStoredProc(Dataset).StoredProcName := Name;
end;

procedure TDAEODACStoredProcedure.SetParamValues(AParams: TDAParamCollection);
begin
  if (AParams.Count <> TOraStoredProc(Dataset).Params.Count) then TOraStoredProc(Dataset).PrepareSQL;
  WriteODACParamValues(AParams, TOraStoredProc(Dataset).Params, TOraStoredProc(Dataset).Session);
end;

procedure TDAEODACStoredProcedure.GetParamValues(AParams: TDAParamCollection);
begin
  ReadODACParamValues(AParams, TOraStoredProc(Dataset).Params, TOraStoredProc(Dataset).Session)
end;

procedure TDAEODACStoredProcedure.RefreshParams;
begin
  TOraStoredProc(Dataset).PrepareSQL;
  RefreshParamsStd(TOraStoredProc(Dataset).Params);
end;

function TDAEODACStoredProcedure.intVCLTypeToDAType(
  aFieldType: TFieldType): TDADataType;
begin
  if ord(aFieldType) in [ftTimeStampTZ,ftTimeStampLTZ] then aFieldType:=ftTimeStamp;
  Result:= inherited intVCLTypeToDAType(aFieldType);
end;

exports GetDriverObject name func_GetDriverObject;

function TDAEODACStoredProcedure.DoExecute: integer;
begin
  with TOraStoredProc(Dataset) do begin
    ExecProc;
    result := RowsAffected;
  end;
end;

initialization
  _driver := nil;
  RegisterDriverProc(GetDriverObject);

finalization
  UnregisterDriverProc(GetDriverObject);
  FreeAndNIL(_driver);

end.