Componentes.Terceros.RemObjects/official/5.0.35.741/Data Abstract for Delphi/Source/Drivers/uDADOADriver.pas

unit uDADOADriver;

// if using DOA 4.0 or higher activate this define
{$DEFINE DOA4}

{$IFDEF MSWINDOWS}
{$I ..\DataAbstract.inc}
{$ELSE}
{$I ../DataAbstract.inc}
{$ENDIF}

interface

uses
  DB,
  Classes,
  uROClasses,
  uDAEngine,
  uDAInterfaces,
  uDAOracleInterfaces,
  uDAUtils,
  Oracle,
  OracleData;

type

  TDADOADriver = class(TDADriverReference)
  end;

  TDAEDOADriver = class(TDAOracleDriver)
  private
    fTraceCallBack: TDALogTraceEvent; // UKO 26.09.2003
  protected
    procedure DoSetTraceOptions(TraceActive: Boolean; TraceOptions:
      TDATraceOptions; Callback: TDALogTraceEvent); override;
    function GetAvailableDriverOptions: TDAAvailableDriverOptions; override;
    function GetConnectionClass: TDAEConnectionClass; override;
    function GetDefaultCustomParameters: string; override;
    function GetDescription: string; override;
    function GetDriverID: string; override;

    procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
  end;

  TDAEDOAConnection = class(TDAOracleConnection)
  private
    function GetOracleSession: TOracleSession;
  protected
    function CreateCompatibleQuery: IDADataset; override;
    function CreateCustomConnection: TCustomConnection; override;
    procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection); override;

    function DoGetInTransaction: boolean; override;
    function DoBeginTransaction: Integer; override;
    procedure DoCommitTransaction; override;
    procedure DoRollbackTransaction; override;
    function GetDataSetClass: TDAEDatasetClass; override;
    function GetStoredProcedureClass: TDAEStoredProcedureClass; override;
    property OracleSession: TOracleSession read GetOracleSession;
  end;

  TDAEDOAQuery = class(TDAEDataSet,  IOracleDataSet)
  private
    function LockModeDaToDoa(LockMode: TDAOracleLockMode): TLockingModeOptions;
    function LockModeDoaToDa(LockMode: TLockingModeOptions): TDAOracleLockMode;
  protected
    procedure ClearParams; override;
    function CreateDataset(aConnection: TDAEConnection): TDataset; override;
    function DoExecute: Integer; override;
    function DoGetSQL: string; override;
    procedure DoPrepare(Value: Boolean); override;
    procedure DoSetSQL(const Value: string); override;
    function GetLockMode: TDAOracleLockMode;
    function GetOptions: TDAOracleOptions;
    procedure SetLockMode(Value: TDAOracleLockMode);
    procedure SetOptions(Value: TDAOracleOptions);
    procedure SetParamValues(Params: TDAParamCollection); override; safecall;
    procedure GetParamValues(Params: TDAParamCollection); override; safecall;
  end;

  TDAEDOAStoredProcedure = class(TDAEStoredProcedure)
  private
    fProcedureName: string;
    FConnection: TDAEDOAConnection;
    procedure DoGetParams;
    function DoGetParamsResult: TDAParam;
    procedure DoSetSource;
  protected
    function CreateDataset(aConnection: TDAEConnection): TDataset; override;
    function Execute: Integer; override;
    function GetStoredProcedureName: string; override;
    procedure RefreshParams; override;
    procedure SetParamValues(Params: TDAParamCollection); override; safecall;
    procedure GetParamValues(Params: TDAParamCollection); override; safecall;
    procedure SetStoredProcedureName(const Name: string); override;
  end;

procedure Register;

function GetDriverObject: IDADriver; stdcall;

implementation

uses
  SysUtils,
  uDADriverManager,
  uDARes;

type
  TDADOAInternalConnection = class(TCustomConnection)
  private
    fOracleSession: TOracleSession;
  protected
    procedure DoConnect; override;
    procedure DoDisconnect; override;
    function GetConnected: Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Session: TOracleSession read fOracleSession;
  end;

  TOraPath = record
    aScheme: string;
    aPackage: string;
    aObject: string;
  end;

var
  _Driver: TDAEDriver = nil;

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


function HandleSqlName(AParamName: string; AParamType: TDAParamType): string;
begin
  Result := AParamName;
  if AParamType = daptResult then Result := 'result';
end;

function DataTypeDaToOra(AType: TDADataType): Integer;
const
  Error = 'INTERNAL: not supported by DOA';
begin
  Result := otString;
  case AType of
    datUnknown: raise Exception.Create(Error);
    datGuid, datString: Result := otString;
    datDateTime: Result := otDate;
    datSingleFloat, datFloat, datCurrency: Result := otFloat;
    datByte,
    datShortInt,
    datWord,
    datCardinal,
    datAutoInc,
    datInteger,
    datLargeInt: Result := otInteger;
    datBoolean: Result := otInteger; // needs a special handling
    datMemo: Result := otClob;
    datBlob: Result := otBlob;
    datXml, datWideString: Result := otVarchar2;
    datWideMemo : Result := otNCLOB;
    datLargeAutoInc, datLargeUInt,datDecimal : Result := otNumber;
  end;
end;

procedure SetDataSetParams(Params: TDAParamCollection; DataSet: TDataSet);
var
  I: Integer;
  Ds: TOracleDataSet;
  ParamIndex, OraType: Integer;
  Name: string;
begin
  Ds := TOracleDataSet(DataSet);
  if Ds.Variables.Count > Params.Count then
    for I := Ds.VariableCount - 1 downto 0 do
      if Params.ParamByName(Ds.VariableName(I)) = nil then
        Ds.DeleteVariable(Ds.VariableName(I));

  for I := 0 to Params.Count - 1 do
  begin
    ParamIndex := Ds.VariableIndex(Params[I].Name);
    Name := HandleSqlName(Params[I].Name, Params[I].ParamType);
    OraType := DataTypeDaToOra(Params[I].DataType);
    // New Param
    if ParamIndex = -1 then
      Ds.DeclareVariable(Name, OraType);
    // Changed Param
    if (ParamIndex > -1) and (Ds.VariableType(ParamIndex) <> DataTypeDaToOra(
      Params[I].DataType)) then
    begin
      Ds.DeleteVariable(Params[I].Name);
      Ds.DeclareVariable(Name, OraType);
    end;
    // Set value
    if Params[I].DataType = datBoolean then
      Ds.SetVariable(Name, Integer(Params[I].Value))
    else
      Ds.SetVariable(Name, Params[I].Value);
  end;
end;

{ INTERNAL CLASSES *********************************************************** }
{
*************************** TDADOAInternalConnection ***************************
}

constructor TDADOAInternalConnection.Create(AOwner: TComponent);
begin
  inherited;
  fOracleSession := TOracleSession.Create(nil);
end;

destructor TDADOAInternalConnection.Destroy;
begin
  fOracleSession.Free;
  inherited;
end;

procedure TDADOAInternalConnection.DoConnect;
begin
  fOracleSession.LogOn;
end;

procedure TDADOAInternalConnection.DoDisconnect;
begin
  fOracleSession.LogOff;
end;

function TDADOAInternalConnection.GetConnected: Boolean;
begin
  Result := fOracleSession.Connected;
end;

{ PUBLIC CLASSES ************************************************************* }
{
******************************** TDAEDOADriver *********************************
}

// -----------------------------------------------------------------------------
// TDAEDOADriver.DoSetTraceOptions
//
// Tracing can only be enabled when DOA Version 4.0 or higher is used.
// UKO 26.09.2003 21:14:47
//

procedure TDAEDOADriver.DoSetTraceOptions(TraceActive: Boolean; TraceOptions:
  TDATraceOptions; Callback: TDALogTraceEvent);
begin
  inherited;

  if TraceActive then
  begin
    fTraceCallBack := Callback;

    {$IFDEF DOA4}
    EnableMonitor;
    {$ENDIF}
  end
  else
  begin
    fTraceCallBack := nil;

    {$IFDEF DOA4}
    DisableMonitor;
    {$ENDIF}
  end;

end;

procedure TDAEDOADriver.GetAuxParams(const AuxDriver: string;
  out List: IROStrings);
begin
  inherited;
end;

// -----------------------------------------------------------------------------
// TDAEDOADriver.GetAvailableDriverOptions
//
// Only Database, Login and Custom needed. doServerName is not needed !
//
// UKO 25.09.2003 17:51:31
//

function TDAEDOADriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
begin
  Result := [doDatabaseName, doLogin{, doCustom}];
end;

function TDAEDOADriver.GetConnectionClass: TDAEConnectionClass;
begin
  Result := TDAEDOAConnection;
end;

function TDAEDOADriver.GetDefaultCustomParameters: string;
begin
  Result:='';
end;

function TDAEDOADriver.GetDescription: string;
begin
  Result := 'Direct Oracle Access Driver'{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF};;
end;

function TDAEDOADriver.GetDriverID: string;
begin
  Result := 'DOA';
end;

{
****************************** TDAEDOAConnection *******************************
}

function TDAEDOAConnection.CreateCompatibleQuery: IDADataset;
begin
  Result := inherited CreateCompatibleQuery;
  OracleSession.LogOn;
end;

function TDAEDOAConnection.CreateCustomConnection: TCustomConnection;
begin
  Result := TDADOAInternalConnection.Create(nil);
end;

// -----------------------------------------------------------------------------
// TDAEDOAConnection.CreateMacroProcessor
//
// UKO 25.09.2003 18:43:06
//


// -----------------------------------------------------------------------------
// TDAEDOAConnection.DoApplyConnectionString
//
// Use Database instead of Server. Server has no meaning in Oracle
// UKO 25.09.2003 17:54:25
//

procedure TDAEDOAConnection.DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
begin
  inherited;
  with aConnStrParser do begin
    OracleSession.LogonDatabase := Database;
    OracleSession.LogonUsername := UpperCase(UserID);
    OracleSession.LogonPassword := Password;
  end;
end;

function TDAEDOAConnection.DoBeginTransaction: Integer;
begin
  // DOA doesn't have any special transaction starting routines
  Result := 0;
end;

procedure TDAEDOAConnection.DoCommitTransaction;
begin
  OracleSession.Commit;
end;

function TDAEDOAConnection.DoGetInTransaction: boolean;
begin
  Result := OracleSession.InTransaction;
end;

procedure TDAEDOAConnection.DoRollbackTransaction;
begin
  OracleSession.Rollback;
end;

function TDAEDOAConnection.GetDataSetClass: TDAEDatasetClass;
begin
  Result := TDAEDOAQuery;
end;

function TDAEDOAConnection.GetOracleSession: TOracleSession;
begin
  Result := TDADOAInternalConnection(inherited ConnectionObject).Session;
end;



function TDAEDOAConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
begin
  Result := TDAEDOAStoredProcedure;
end;

// -----------------------------------------------------------------------------
// TDAEDOAConnection.IdentifierNeedsQuoting
//
// Default behavior not enough, as '$' and '.' are also a valid character which doesn<73>t need quoting
//
// UKO 25.09.2003 11:48:13
//

{
********************************* TDAEDOAQuery *********************************
}

procedure TDAEDOAQuery.ClearParams;
begin
  inherited;
  TOracleDataSet(Dataset).ClearVariables;
end;

function TDAEDOAQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
begin
  Result := TOracleDataSet.Create(nil);
  TOracleDataSet(Result).ReadOnly := True;
  TOracleDataSet(Result).Session := TDAEDOAConnection(aConnection).OracleSession;
end;

function TDAEDOAQuery.DoExecute: Integer;
begin
  TOracleDataSet(DataSet).ExecSQL;
  Result := -1;
end;

function TDAEDOAQuery.DoGetSQL: string;
begin
  Result := TOracleDataSet(Dataset).SQL.Text;
end;

procedure TDAEDOAQuery.DoPrepare(Value: Boolean);
begin
  TOracleDataSet(DataSet).Optimize := Value;
end;

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

function TDAEDOAQuery.GetLockMode: TDAOracleLockMode;
begin
  Result := LockModeDoaToDa(TOracleDataSet(Dataset).LockingMode)
end;

function TDAEDOAQuery.GetOptions: TDAOracleOptions;
begin
  // Can't be implemented
end;

procedure TDAEDOAQuery.GetParamValues(Params: TDAParamCollection);
var
  i: integer;
  par: TDAParam;
  ds: TOracleDataSet;
begin
  ds := TOracleDataSet(Dataset);
  if not Assigned(ds.Variables) then Exit;

  for i := 0 to (ds.VariableCount - 1) do begin
    par := Params.ParamByName(copy(ds.VariableName(i),2,MaxInt));
    if par.ParamType in [daptOutput, daptInputOutput, daptResult] then
       par.Value := ds.GetVariable(i);
  end;
end;

function TDAEDOAQuery.LockModeDaToDoa(LockMode: TDAOracleLockMode):
  TLockingModeOptions;
begin
  Result := lmNone;
  case LockMode of
    olmLockImmediate: Result := lmLockImmediate;
    olmLockDelayed: Result := lmLockDelayed;
  end;
end;

function TDAEDOAQuery.LockModeDoaToDa(LockMode: TLockingModeOptions):
  TDAOracleLockMode;
begin
  Result := olmNone;
  case LockMode of
    lmLockImmediate: Result := olmLockImmediate;
    lmLockDelayed: Result := olmLockDelayed;
  end;
end;

procedure TDAEDOAQuery.SetLockMode(Value: TDAOracleLockMode);
begin
  TOracleDataSet(Dataset).LockingMode := LockModeDaToDoa(Value);
end;

procedure TDAEDOAQuery.SetOptions(Value: TDAOracleOptions);
begin
  // Can't be implemented
end;

procedure TDAEDOAQuery.SetParamValues(Params: TDAParamCollection);
begin
  SetDataSetParams(Params, DataSet);
end;

{
**************************** TDAEDOAStoredProcedure ****************************
}

function TDAEDOAStoredProcedure.CreateDataset(aConnection: TDAEConnection): TDataset;
begin
  Result := TOracleDataSet.Create(nil);
  FConnection := TDAEDOAConnection(aConnection); 
  TOracleDataSet(Result).Session := TDAEDOAConnection(aConnection).OracleSession;
end;

procedure TDAEDOAStoredProcedure.DoGetParams;
var
  Ds: TOracleDataSet;
  I: Integer;
  Params: TDAParamCollection;
begin
  Params := GetParams;
  Ds := TOracleDataSet(DataSet);
  for I := 0 to Params.Count - 1 do
    if Params[I].ParamType in [daptOutput, daptInputOutput, daptResult] then
      Params[I].Value := Ds.GetVariable(HandleSqlName(Params[I].Name, Params[I].ParamType));
end;

function TDAEDOAStoredProcedure.DoGetParamsResult: TDAParam;
var
  I: Integer;
  Params: TDAParamCollection;
begin
  Result := nil;
  Params := GetParams;
  for I := 0 to Params.Count - 1 do
    if Params[I].ParamType = daptResult then
    begin
      Result := Params[I];
      Exit;
    end;
end;

procedure TDAEDOAStoredProcedure.DoSetSource;
var
  Ds: TOracleDataSet;
  I: Integer;
  Params: TDaParamCollection;
  ParamResult: TDAParam;
  ParamsExist: Boolean;

const
  SQLHeader = 'declare' + sLineBreak +
    '  result boolean;' + sLineBreak +
    'begin' + sLineBreak;
  SQLHandleBoolean = ':result := sys.diutil.bool_to_int(function_result);';
  SQLFooter = 'end;';

  function CaseOfParam(const AParamResult: TDAParam): Integer;
  begin
    Result := 0;
    if AParamResult <> nil then
      if AParamResult.DataType = datBoolean then
        Result := 1
      else
        Result := 2;
  end;

  function ConvertParam(const AName: string; const ADataType: TDADataType):
      string;
  begin
    if ADataType = datBoolean then
    begin
      Result := Format('%s => sys.diutil.int_to_bool(:%s), ', [AName, AName]);
      Exit;
    end;
    Result := Format('%s => :%s, ', [AName, AName]);
  end;

  function TrimSqlParams(const SQL: string): string;
  var
    S: string;
  begin
    S := SQL;
    Delete(S, Length(S) - 3, 4);
    Result := S;
  end;

begin
  Ds := TOracleDataSet(DataSet);
  Params := GetParams;
  ParamResult := DoGetParamsResult;
  // PL/SQL Block - header + stored proc name
  Ds.SQL.Text := SQLHeader;
  case CaseOfParam(ParamResult) of // 0 = no result, 1 = boolean, 2 = misc
    0: Ds.SQL.Add(Format('  %s(', [fProcedureName]));
    1: Ds.SQL.Add(Format('  result := %s(', [fProcedureName]));
    2: Ds.SQL.Add(Format('  :result := %s(', [fProcedureName]));
  end;
  // PL/SQL Block - params if any;
  ParamsExist := False;
  for I := 0 to Params.Count - 1 do
    if (Params.Items[I] <> ParamResult) then
    begin
      ParamsExist := True;
      Ds.SQL.Add(ConvertParam(Params[I].Name, Params[I].DataType));
    end;
  // PL/SQL Block - params - remove the last half-stop
  if ParamsExist then
    Ds.SQL.Text := TrimSQLParams(Ds.SQL.Text);
  Ds.SQL.Add(');');
  // PL/SQL Block - special treatment for functions with boolean results
  if ParamResult.DataType = datBoolean then
    Ds.SQL.Add(SQLHandleBoolean);
  Ds.SQL.Add(SQLFooter);
end;

function TDAEDOAStoredProcedure.Execute: Integer;
var
  Params: TDAParamCollection;
begin
  Params := GetParams;
  SetDataSetParams(Params, DataSet);
  DoSetSource;
  TOracleDataSet(DataSet).ExecSQL;
  DoGetParams;
  Result := -1;
end;

function TDAEDOAStoredProcedure.GetStoredProcedureName: string;
begin
  Result := fProcedureName;
end;

procedure TDAEDOAStoredProcedure.RefreshParams;
var
  OraParams: TDAParamCollection;
begin
  Oracle_DoGetStoredProcedureParams(fProcedureName, FConnection.CreateCompatibleQuery,OraParams);
  GetParams.AssignParamCollection(OraParams);
end;

procedure TDAEDOAStoredProcedure.GetParamValues(Params: TDAParamCollection);
var
  i: integer;
  par: TDAParam;
  ds: TOracleDataSet;
begin
  ds := TOracleDataSet(Dataset);
  if not Assigned(ds.Variables) then Exit;

  for i := 0 to (ds.VariableCount - 1) do begin
    par := Params.ParamByName(ds.VariableName(i));
    if par.ParamType in [daptOutput, daptInputOutput, daptResult] then
       par.Value := ds.GetVariable(i);
  end;
end;

procedure TDAEDOAStoredProcedure.SetParamValues(Params: TDAParamCollection);
begin
  SetDataSetParams(Params, DataSet);
end;

procedure TDAEDOAStoredProcedure.SetStoredProcedureName(const Name: string);
begin
  fProcedureName := Name;
end;

exports
  GetDriverObject name func_GetDriverObject;

initialization
  _Driver := nil;
  RegisterDriverProc(GetDriverObject);

finalization
  UnregisterDriverProc(GetDriverObject);
  FreeAndNil(_Driver);

end.