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

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;

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(TDAEConnection, IDAOracleConnection, IDAUseGenerators, IDACanQueryDatabaseNames)
  private
    fConnection: TORASession;

    procedure GetSysObjects(const aCondition: string; aList: TStrings);
    procedure GetSynObjects(const aCondition: string; aList: TStrings);

  protected
    // IDAUseGenerators
    function GetNextAutoinc(const GeneratorName: string): integer; safecall;

    function CreateCustomConnection: TCustomConnection; override;
    function CreateMacroProcessor: TDASQLMacroProcessor; 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;

    function DoGetLastAutoInc(const GeneratorName: string): integer; override;

    procedure DoGetTableNames(out List: IROStrings); override;
    procedure DoGetViewNames(out List: IROStrings); override;
    procedure DoGetStoredProcedureNames(out List: IROStrings); override;
    function GetSPSelectSyntax(HasArguments: Boolean): String; override; safecall;

  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;

       // 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(Params: TDAParamCollection); safecall;

    procedure GetParamValues(Params: TDAParamCollection); safecall;

  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;
    function Execute: integer; override;

        // IDAMustSetParams
    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, [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 WriteODACParamValues(
   InputParams : TDAParamCollection;
   OutputParams: TDAParams);
var i : integer;
    par : uDAInterfaces.TDAParam;
    outpar : DBAccess.TDAParam;
    ms: IROStream;
    blobtype : TFieldType;
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];

        ms := TROStream.Create;
        par.SaveToStream(ms);
        ms.Position := 0;
        if ms.Size>0
          then outpar.LoadFromStream(ms.Stream, blobtype);

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

        // Only happens with Oracle
        if (blobtype<>ftUnknown)
          then outpar.DataType := blobtype;
        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;
        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.GetSysObjects(const aCondition: string; aList: TStrings);
var
  ds: TSmartQuery;
begin
  ds := TSmartQuery.Create(nil);
  with ds do try
    Connection := fConnection;
    SQL.Text := 'select object_name from all_objects ' + aCondition + ' and owner =''' + UpperCase(fConnection.Username) + '''';
    Open;

    while not ds.EOF do begin
      aList.Add(ds.FieldByName('object_name').AsString);
      Next;
    end;
  finally
    ds.Free;
  end;
end;

procedure TDAEODACConnection.DoGetStoredProcedureNames(out List: IROStrings);
begin
  List := TROStrings.Create;
  GetSysObjects('where (object_type = ''PROCEDURE'' or object_type = ''FUNCTION'')', List.Strings);
  GetSynObjects('(ao.object_type    = ''PROCEDURE'' or ao.object_type = ''FUNCTION'')', List.Strings);
end;

procedure TDAEODACConnection.DoGetTableNames(out List: IROStrings);
begin
  List := TROStrings.Create;
  GetSysObjects('where object_type = ''TABLE''', List.Strings);
  GetSynObjects('ao.object_type = ''TABLE''', List.Strings);
end;

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

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

function TDAEODACConnection.CreateMacroProcessor: TDASQLMacroProcessor;
begin
  result := Oracle_CreateMacroProcessor;
end;

function TDAEODACConnection.DoGetLastAutoInc(const GeneratorName: string): integer;
begin
  Result := Oracle_DoGetLastAutoInc(GeneratorName,GetDatasetClass.Create(Self));
end;

procedure TDAEODACConnection.DoGetViewNames(out List: IROStrings);
begin
  List := TROStrings.Create;
  GetSysObjects('where object_type = ''VIEW''', List.Strings);
  GetSynObjects('ao.object_type = ''VIEW''', List.Strings);
end;

function TDAEODACConnection.GetNextAutoinc(
  const GeneratorName: string): integer;
begin
  Result := Oracle_GetNextAutoinc(GeneratorName,GetDatasetClass.Create(Self));
end;

procedure TDAEODACConnection.GetSynObjects(const aCondition: string;
  aList: TStrings);
var
  ds: TSmartQuery;
begin
  ds := TSmartQuery.Create(nil);
  with ds do try
    Connection := fConnection;
    SQL.Text := 'select distinct(us.synonym_name) from all_synonyms us, all_objects ao where  us.table_owner = ao.owner  and '+
                  'us.table_name  = ao.object_name and '+
                  '(us.owner =''' + UpperCase(fConnection.Username) +  ''' or us.owner = ''PUBLIC'') and '+aCondition;
    Open;

    while not ds.EOF do begin
      aList.Add(ds.FieldByName('synonym_name').AsString);
      Next;
    end;
  finally
    ds.Free;
  end;
end;

function TDAEODACConnection.GetSPSelectSyntax(
  HasArguments: Boolean): String;
begin
  if HasArguments then
    Result := 'CALL {0}({1})' else Result := 'CALL {0}';
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
  inherited DoExecute;
  result := TSmartQuery(Dataset).RowsAffected;

end;

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

procedure TDAEODACQuery.GetParamValues(Params: TDAParamCollection);
var                              
  i: integer;
begin
  for i := 0 to TOraQuery(Dataset).Params.Count - 1 do
    if (TSmartQuery(Dataset).Params[i].ParamType in [ptOutput, ptInputOutput, ptResult]) then params[i].Value := TSmartQuery(Dataset).Params[i].Value;
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;
  Result:= inherited intVCLTypeToDAType(aFieldType);
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;
begin
  _params := GetParams;

  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[i].Value;

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


    ExecProc;
    result := RowsAffected;

    for i := 0 to (_params.Count-1) do
      if (_params[i].ParamType in [daptOutput, daptInputOutput, daptResult])
        then _params[i].Value := params.ParamByName(_params[i].Name).Value;

  end;
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(Params: TDAParamCollection);
begin
  WriteODACParamValues(Params, TOraStoredProc(Dataset).Params);
end;

procedure TDAEODACStoredProcedure.GetParamValues(Params: TDAParamCollection);
var
  i: Integer;
begin
  for i := 0 to TOraStoredProc(Dataset).Params.Count - 1 do
    if (TOraStoredProc(Dataset).Params[i].ParamType in [ptOutput, ptInputOutput, ptResult]) then params[i].Value := TOraStoredProc(Dataset).Params[i].Value;
end;

procedure TDAEODACStoredProcedure.RefreshParams;
begin
  TOraStoredProc(Dataset).PrepareSQL;
  inherited;
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;

initialization
  _driver := nil;
  RegisterDriverProc(GetDriverObject);

finalization
  UnregisterDriverProc(GetDriverObject);
  FreeAndNIL(_driver);

end.