unit uDADOADriver;

interface

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

type

  TDADOADriver = class(TDADriverReference)
  end;

  TDAEDOADriver = class(TDAEDriver)
  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;
    function GetMajVersion: byte; override;
    function GetMinVersion: byte; override;

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

  TDAEDOAConnection = class(TDAECOnnection, IOracleConnection)
  private
    fSysObjects: Boolean;
    fSchema: string;
    fUsername: string;
    function GetObjects(Schema, WhereClause: string): IROStrings;
    function GetEncodedObjects(WhereClause: string): IROStrings;
    function GetOracleSession: TOracleSession;
    function GetStoredProcsInPackages(Schema: string): IROStrings;
    function EncodeSchema(const Username, Schema: string; Contents: IROStrings): IROStrings;
    function GetPrimaryKeys(const Schema, TableName: string): IROStrings;
    function GetConstraintColumnsAsString(const AOwner, AConstraintName: string; out AColumns: string): string;
  protected
    function CreateCustomConnection: TCustomConnection; override;
    function CreateMacroProcessor: TDASQLMacroProcessor; override;

    procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection); override;

    function DoBeginTransaction: Integer; override;
    procedure DoCommitTransaction; override;
    procedure DoGetStoredProcedureNames(out List: IROStrings); override;
    procedure DoGetStoredProcedureParams(const aStoredProcedureName: string;
      out Params: TDAParamCollection); override;
    procedure DoGetTableFields(const aTableName: string; out Fields:
      TDAFieldCollection); override;
    procedure DoGetTableNames(out List: IROStrings); override;
    procedure DoGetViewFields(const aViewName: string; out Fields:
      TDAFieldCollection); override;
    procedure DoGetViewNames(out List: IROStrings); override;
    procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); override;
    procedure DoRollbackTransaction; override;
    function GetDataSetClass: TDAEDatasetClass; override;
    function GetStoredProcedureClass: TDAEStoredProcedureClass; override;
    property OracleSession: TOracleSession read GetOracleSession;

    function IdentifierNeedsQuoting(const iIdentifier: string): boolean; override;
  end;

  TDAEDOAQuery = class(TDAEDataSet, IDAMustSetParams, IOracleDataSet)
  private
    function LockModeDaToDoa(LockMode: TOracleLockMode): TLockingModeOptions;
    function LockModeDoaToDa(LockMode: TLockingModeOptions): TOracleLockMode;
  protected
    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: TOracleLockMode;
    function GetOptions: TOracleOptions;
    procedure SetLockMode(Value: TOracleLockMode);
    procedure SetOptions(Value: TOracleOptions);
    procedure SetParamValues(Params: TDAParamCollection); safecall;
    procedure GetParamValues(Params: TDAParamCollection); safecall;
  end;

  TDAEDOAStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
  private
    fProcedureName: string;
    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); safecall;
    procedure SetStoredProcedureName(const Name: string); override;
  end;

procedure Register;

function GetDriverObject: IDADriver; stdcall;

implementation

{$INCLUDE DOA.INC}

uses
  SysUtils,
  uDADriverManager,
  uDARes,
  {$IFDEF DOA4}
  OracleMonitor,
  {$ENDIF}
  uDAMacroProcessors;

const
  NL = #13#10;

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;

function GetDriverObject: IDADriver;
begin
  if (_Driver = nil) then
    _Driver := TDAEDOADriver.Create(nil);
  Result := _Driver;
end;

{ HELPERS ******************************************************************** }

function CaseStringOf(const Value: string; const Args: array of string):
  Integer;
begin
  for Result := High(Args) downto 0 do
    if AnsiSameStr(Value, Args[Result]) then
      Break;
end;

function ParamTypeOraToDa(const AName, AType: string): TDAParamType;
begin
  Result := daptUnknown;
  if AnsiSameStr(AType, 'IN') then
    Result := daptInput;
  if AnsiSameStr(AType, 'OUT') then
  begin
    if Length(AName) = 0 then
      Result := daptResult
    else
      Result := daptOutput;
  end;
  if AnsiSameStr(AType, 'IN/OUT') then
    Result := daptInputOutput;
end;

function DataTypeOraToVcl(const AName: string; AScale: Integer): TFieldType;
begin
  Result := ftUnknown;
  case CaseStringOf(AName, ['BINARY_INTEGER', 'NUMBER', 'CHAR', 'NCHAR',
    'VARCHAR2', 'NVARCHAR2', 'DATE', 'BLOB', 'CLOB', 'NCLOB', 'PL/SQL BOOLEAN',
      'FLOAT']) of
    0, 1:
      if AScale = 0 then
        Result := ftInteger
      else
        Result := ftFloat;
    2, 3, 4, 5: Result := ftString;
    6: Result := ftDate;
    7: Result := ftBlob;
    8, 9: Result := ftMemo;
    10: Result := ftBoolean;
    11: Result := ftFloat;
  end;
end;

// 1) extended with DefaultScheme
// 2) if Scheme is not the Default and not SYS or SYSTEM then handle it as Packagename
// UKO 25.09.2003

function ExtractOraPath(AOraPath: string; ADefaultScheme: string): TOraPath;
var
  PathList: TStringList;
  Count: Integer;
begin
  Result.aScheme := '';
  Result.aPackage := '';
  Result.aObject := '';
  PathList := TStringList.Create;
  try
    Count := ExtractStrings(['.'], [' '], PAnsiChar(AOraPath), PathList);
    case Count of
      0: ;
      1:
        begin
          Result.aObject := AOraPath;
          Result.aScheme := ADefaultScheme;
        end;
      2:
        begin
          Result.aObject := PathList[1];
          Result.aScheme := PathList[0];

          // The case of packages must be handled seperatly :
          // UKO 25.09.2003
          if (AnsiCompareText(Result.aScheme, ADefaultScheme) <> 0) and
            (AnsiCompareText(Result.aScheme, 'SYS') <> 0) and
            (AnsiCompareText(Result.aScheme, 'SYSTEM') <> 0) then
          begin
            Result.aScheme := ADefaultScheme;
            Result.aPackage := PathList[0];
            Result.aObject := PathList[1];
          end;
        end;
    else
      begin
        Result.aObject := PathList[PathList.Count - 1];
        Result.aPackage := PathList[PathList.Count - 2];
        Result.aScheme := PathList[PathList.Count - 3];
      end;
    end;
    UpperCase(Result.aScheme);
    UpperCase(Result.aPackage);
    UpperCase(Result.aObject);
  finally
    PathList.Free;
  end;
end;

function ProcessWhereExp(AName, AValue: string): string;
begin
  Result := Format('%s =''%s''', [AName, AValue]);
  if AValue = '' then
    Result := Format('%s is null', [AName]);
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);
    datString: Result := otString;
    datDateTime: Result := otDate;
    datFloat: Result := otFloat;
    datCurrency: Result := otFloat;
    datAutoInc: raise Exception.Create(Error);
    datInteger: Result := otInteger;
    datLargeInt: Result := otInteger;
    datBoolean: Result := otInteger; // needs a special handling
    datMemo: Result := otClob;
    datBlob: Result := otBlob;
  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;

procedure GetStoredProcParams(
  OracleSession: TOracleSession;
  const aStoredProcedureName: string;
  out Params: TDAParamCollection);
var
  Query: TOracleQuery;
  OraPath: TOraPath;
const
  SQL = 'select ' + NL +
    '  argument_name, data_type, in_out, data_length, data_precision, data_scale ' + NL +
    'from all_arguments' + NL +
    'where' + NL +
    '  ((in_out = ''IN'' and argument_name IS NOT NULL) or in_out = ''OUT'' or in_out = ''IN/OUT'') ' + NL +
    '  and %s' + NL +
    '  and %s' + NL +
    '  and %s';
begin
  Params := TDAParamCollection.Create(nil);
  Query := TOracleQuery.Create(nil);
  try
    OraPath := ExtractOraPath(aStoredProcedureName, OracleSession.LogonUsername);
    Query.Session := OracleSession;
    Query.SQL.Text := Format(SQL, [ProcessWhereExp('owner', OraPath.aScheme),
      ProcessWhereExp('package_name', OraPath.aPackage),
        ProcessWhereExp('object_name', OraPath.aObject)]);
    Query.Execute;
    while not (Query.Eof) do
    begin
      with Params.Add() do
      begin
        ParamType := ParamTypeOraToDa(Query.Field(0), Query.Field(2));
        Name := HandleSqlName(Query.Field(0), ParamType);
        DataType := VCLTypeToDAType(DataTypeOraToVcl(Query.Field(1),
          Query.Field(5)));
        Size := Query.Field(4);
      end;
      Query.Next;
    end;
  finally
    Query.Close;
    Query.Free;
  end;
end;

procedure AddStrings(Base, Addition: IROStrings);
var
  I: Integer;
begin
  for I := 0 to Addition.Count - 1 do
    Base.Add(Addition[I]);
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;
  List.Add('SysObjects=0,1');
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 := 'SysObjects=0';
end;

function TDAEDOADriver.GetDescription: string;
begin
  Result := 'Direct Oracle Access Driver';
end;

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

// -----------------------------------------------------------------------------
// TDAEDOADriver.GetMajVersion
//
// UKO 25.09.2003 17:45:47
//

function TDAEDOADriver.GetMajVersion: byte;
begin
  Result := 1;
end;

// -----------------------------------------------------------------------------
// TDAEDOADriver.GetMinVersion
//
// UKO 25.09.2003 17:45:49
//

function TDAEDOADriver.GetMinVersion: byte;
begin
  Result := 1;
end;

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

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

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

function TDAEDOAConnection.CreateMacroProcessor: TDASQLMacroProcessor;
begin
  result := TOracleMacroProcessor.Create;
end;

// -----------------------------------------------------------------------------
// 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
    fUserName := UpperCase(UserID);
    OracleSession.LogonDatabase := Database;
    OracleSession.LogonUsername := fUserName;
    OracleSession.LogonPassword := Password;

    fSchema := fUserName;
    fSysObjects := AuxParams['SysObjects'] = '1';
  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;

procedure TDAEDOAConnection.DoGetForeignKeys(
  out ForeignKeys: TDADriverForeignKeyCollection);
type
  TFKRec =
  record
    TableName: string;
    ConstraintName: string;
    ReferenzContraintName: string;
    ReferenzOwner: string;
  end;
var
  lReferenzTable: string;
  lQuery: TOracleQuery;
  lColumns: string;
  lFKArray: array of TFKRec;
  lIndex: integer;
  lfv: integer;
const
  SQL =
    'SELECT constraint_name, table_name, r_owner, r_constraint_name  FROM all_constraints' + #13#10 +
    'WHERE owner = ''%s''' + #13#10 +
    'AND constraint_type = ''R''';
begin
  inherited; // creates an empty collection

  OracleSession.LogOn;
  lQuery := TOracleQuery.Create(nil);
  try
    lQuery.Session := OracleSession;
    lQuery.SQL.Text := Format(SQL, [Uppercase(OracleSession.LogonUsername)]);
    lQuery.Execute;
    lIndex := 0;

    while not (lQuery.Eof) do
    begin
      SetLength(lFKArray, lIndex+1);
      lFKArray[lIndex].ConstraintName := lQuery.FieldAsString('CONSTRAINT_NAME');
      lFKArray[lIndex].TableName := lQuery.FieldAsString('TABLE_NAME');
      lFKArray[lIndex].ReferenzOwner := lQuery.FieldAsString('R_OWNER');
      lFKArray[lIndex].ReferenzContraintName := lQuery.FieldAsString('R_CONSTRAINT_NAME');
      inc(lIndex);
      lQuery.Next;
    end;
  finally
    lQuery.Free;
  end;

  if lIndex > 0 then
  begin
    for lfv := 0 to Length(lFKArray)-1 do
    begin
      with ForeignKeys.Add() do
      begin
        GetConstraintColumnsAsString(Uppercase(OracleSession.LogonUsername), lFKArray[lfv].ConstraintName, lColumns);
        FKTable := lFKArray[lfv].TableName;
        FKField := lColumns;

        lReferenzTable := GetConstraintColumnsAsString(lFKArray[lfv].ReferenzOwner, lFKArray[lfv].ReferenzContraintName, lColumns);
        PKTable := lReferenzTable;
        PKField := lColumns;
      end;
    end;
  end;
end;

procedure TDAEDOAConnection.DoGetStoredProcedureNames(out List: IROStrings);
begin
  List := EncodeSchema(fUserName, fSchema, GetStoredProcsInPackages(fSchema));
  if fSysObjects then
  begin
    AddStrings(List, EncodeSchema(fUserName, 'SYS', GetStoredProcsInPackages('SYS')));
    AddStrings(List, EncodeSchema(fUserName, 'SYSTEM', GetStoredProcsInPackages('SYSTEM')));
  end;
  AddStrings(List, GetEncodedObjects(' (object_type = ''FUNCTION'' or object_type = ''PROCEDURE'')'));
end;

procedure TDAEDOAConnection.DoGetStoredProcedureParams(const
  aStoredProcedureName: string; out Params: TDAParamCollection);
begin
  OracleSession.LogOn;
  GetStoredProcParams(OracleSession, aStoredProcedureName, Params);
end;

procedure TDAEDOAConnection.DoGetTableFields(const aTableName: string; out
  Fields: TDAFieldCollection);
var
  Query: TOracleQuery;
  OraPath: TOraPath;
  PrimaryKey: IROStrings;
const
  SQL = 'SELECT atc.column_name, atc.data_type, atc.data_length, atc.data_scale, atc.nullable, acc.comments' + #13#10 +
    'FROM all_tab_columns atc, all_col_comments acc' + #13#10 +
    'WHERE atc.owner = ''%s''' + #13#10 +
    'AND atc.table_name = ''%s''' + #13#10 +
    'AND acc.owner= atc.OWNER' + #13#10 +
    'AND acc.table_name=atc.TABLE_NAME' + #13#10 +
    'AND acc.column_name=atc.COLUMN_NAME';

begin
  OracleSession.LogOn;
  Fields := TDAFieldCollection.Create(nil);
  Query := TOracleQuery.Create(nil);
  try
    OraPath := ExtractOraPath(aTableName, OracleSession.LogonUsername);
    PrimaryKey := GetPrimaryKeys(OraPath.aScheme, OraPath.aObject);
    Query.Session := OracleSession;
    Query.SQL.Text := Format(SQL, [OraPath.aScheme, OraPath.aObject]);
    Query.Execute;
    // if Query.Eof then ????? UKO  10.09.2003
    while not Query.Eof do
    begin
      with Fields.Add() do
      begin
        Name := Query.Field(0);
        InPrimaryKey := (PrimaryKey.IndexOf(Name) > -1);
        DataType := VCLTypeToDAType(DataTypeOraToVcl(Query.Field(1),
          Query.Field(3)));
        Size := Query.Field(2);

        // UKO 17.09.2004  get additional information
        Required := (Query.FieldAsString(4) = 'N');
        Description := Query.FieldAsString(5);
        // TODO: Defaultvalue
      end;
      Query.Next;
    end;
    Query.Close;
  finally
    Query.Free;
  end;
end;

procedure TDAEDOAConnection.DoGetTableNames(out List: IROStrings);
begin
  List := GetEncodedObjects(' (object_type = ''TABLE'')');
end;

procedure TDAEDOAConnection.DoGetViewFields(const aViewName: string; out
  Fields: TDAFieldCollection);
begin
  DoGetTableFields(aViewName, Fields);
end;

procedure TDAEDOAConnection.DoGetViewNames(out List: IROStrings);
begin
  List := GetEncodedObjects(' (object_type = ''VIEW'')');
end;

procedure TDAEDOAConnection.DoRollbackTransaction;
begin
  TOracleSession(inherited ConnectionObject).Rollback;
end;

function TDAEDOAConnection.EncodeSchema(const Username, Schema: string;
  Contents: IROStrings): IROStrings;
var
  I: Integer;
begin
  Result := Contents;
  if Username <> Schema then // scheme only when different then user  UKO 25.09.2003
    for I := 0 to Result.Count - 1 do
      Result[I] := Schema + '.' + Result[I];
end;

function TDAEDOAConnection.GetConstraintColumnsAsString(const AOwner,
  AConstraintName: string; out AColumns: string): string;
var
  Query: TOracleQuery;
const
  SQL =
    'SELECT Table_name, Column_Name FROM All_Cons_Columns' + #13#10 +
    'WHERE owner = ''%s''' + #13#10 +
    'AND constraint_name = ''%s''' + #13#10 +
    'ORDER BY position';
begin
  Result := '';
  AColumns := '';
  OracleSession.LogOn;
  Query := TOracleQuery.Create(nil);
  try
    Query.Session := OracleSession;
    Query.SQL.Text := Format(SQL, [AOwner, AConstraintName]);
    Query.Execute;

    while not (Query.Eof) do
    begin
      Result := Query.FieldAsString('TABLE_NAME');
      AColumns := AColumns + Query.FieldAsString('COLUMN_NAME');
      Query.Next;
      if not Query.Eof then
        AColumns := AColumns + ',';
    end;
    Query.Close;
  finally
    Query.Free;
  end;
end;

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

function TDAEDOAConnection.GetEncodedObjects(
  WhereClause: string): IROStrings;
begin
  Result := TROStrings.Create;
  AddStrings(Result, EncodeSchema(fUserName, fSchema, GetObjects(fSchema, WhereClause)));
  if fSysObjects then
  begin
    AddStrings(Result, EncodeSchema(fUserName, 'SYS', GetObjects('SYS', WhereClause)));
    AddStrings(Result, EncodeSchema(fUserName, 'SYSTEM', GetObjects('SYSTEM', WhereClause)));
  end;
end;

function TDAEDOAConnection.GetObjects(Schema, WhereClause: string): IROStrings;
var
  Query: TOracleQuery;
const
  SQL = 'select object_name as object' + NL +
    'from all_objects where owner = ''%s'' and %s';

begin
  Result := TROStrings.Create;
  OracleSession.LogOn;
  Query := TOracleQuery.Create(nil);
  try
    Query.Session := OracleSession;
    Query.SQL.Text := Format(SQL, [Schema, WhereClause]);
    Query.Execute;

    while not (Query.Eof) do
    begin
      Result.Add(Query.Field(0));
      Query.Next;
    end;
    Query.Close;
  finally
    Query.Free;
  end;
end;

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

function TDAEDOAConnection.GetPrimaryKeys(const Schema,
  TableName: string): IROStrings;
var
  Query: TOracleQuery;
const
  // this statement doesn´t work properly if the table is in more then one
  // database users available (e.g. two different versions of the database user)
  // In this case duplicated results are generated and performance decreases cause
  // of a full table scan on obj$
  // Solution: link also owner and tablename !
  // UKO 23.09.2003

  //
  //  SQL = 'select' + NL +
  //        '  a.column_name' + NL +
  //        'from' + NL +
  //        '  all_cons_columns a, all_constraints b' + NL +
  //        'where a.constraint_name = b.constraint_name' + NL +
  //        '  and b.constraint_type = ''P''' + NL +
  //        '  and b.owner = ''%s''' + NL +
  //        '  and b.table_name = ''%s''';

  SQL = 'select' + NL +
    '  a.column_name' + NL +
    'from' + NL +
    '  all_cons_columns a, all_constraints b' + NL +
    'where a.owner = b.owner' + NL +
    '  and a.table_name = b.table_name' + NL +
    '  and a.constraint_name = b.constraint_name' + NL +
    '  and b.constraint_type = ''P''' + NL +
    '  and b.owner = ''%s''' + NL +
    '  and b.table_name = ''%s''';
begin
  Result := TROStrings.Create;
  Query := TOracleQuery.Create(nil);
  try
    Query.Session := OracleSession;
    Query.SQL.Text := Format(SQL, [UpperCase(Schema), UpperCase(TableName)]);
    Query.Execute;
    while not (Query.Eof) do
    begin
      Result.Add(Query.Field(0));
      Query.Next;
    end;
  finally
    Query.Free;
  end;
end;

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

// -----------------------------------------------------------------------------
// TDAEDOAConnection.GetStoredProcsInPackages
//
// UKO 25.09.2003 11:48:08
//

function TDAEDOAConnection.GetStoredProcsInPackages(Schema: string): IROStrings;
var
  Query: TOracleQuery;
const
  SQL = 'select distinct package_name || ''.'' || object_name as proc ' + NL +
    'from all_arguments' + NL +
    'where package_name is not null and owner = ''%s''';

begin
  Result := TROStrings.Create;
  OracleSession.LogOn;
  Query := TOracleQuery.Create(nil);
  try
    Query.Session := OracleSession;
    Query.SQL.Text := Format(SQL, [Schema]);
    Query.Execute;
    while not (Query.Eof) do
    begin
      Result.Add(Query.Field(0));
      Query.Next;
    end;
  finally
    Query.Close;
    Query.Free;
  end;
end;

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

function TDAEDOAConnection.IdentifierNeedsQuoting(const iIdentifier: string): boolean;
var
  i: integer;
begin
  result := false;
  if IdentifierIsQuoted(iIdentifier) then
    exit;
  for i := 1 to Length(iIdentifier) do
  begin
    if not (iIdentifier[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '$', '.']) then
    begin
      result := true;
      exit;
    end;
  end;
end;

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

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: TOracleLockMode;
begin
  Result := LockModeDoaToDa(TOracleDataSet(Dataset).LockingMode)
end;

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

procedure TDAEDOAQuery.GetParamValues(Params: TDAParamCollection);
begin
  // 
end;

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

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

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

procedure TDAEDOAQuery.SetOptions(Value: TOracleOptions);
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);
  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' + NL +
    '  result boolean;' + NL +
    'begin' + NL;
  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, DaParams: TDAParamCollection;
begin
  GetStoredProcParams(TOracleDataSet(DataSet).Session, fProcedureName,
    OraParams);
  DaParams := GetParams;
  DaParams.AssignParamCollection(OraParams);
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.