oracleuniprovider.pas

CrLab UniDAC 1.0 include sources

{$IFNDEF CLR}
{$I Odac.inc}
unit OracleUniProvider;
{$ENDIF}

interface

uses
  SysUtils, Classes, Variants, DB, CRAccess, CRConnectionPool, MemData, MemDS, DBAccess,
  CRParser, DAScript, UniProvider;

type
  TOracleUniProvider = class(TUniProvider)
  public
    class function GetProviderName: string; override;

    function NeedRecreateProcCall: boolean; override;

    function GetParserClass: TParserClass; override;
    function GetConnectionParametersClass: TCRConnectionParametersClass; override;
    function GetConnectionPoolingManagerClass: TCRConnectionPoolManagerClass; override;
    function GetConnectionClass: TCRConnectionClass; override;
    function GetServerEnumeratorClass: TCRServerEnumeratorClass; override;    
    function GetTransactionClass: TCRTransactionClass; override;
    function GetCommandClass: TCRCommandClass; override;
    function GetRecordSetClass: TCRRecordSetClass; override;
    function GetDataSetServiceClass: TDADataSetServiceClass; override;
    function GetScriptProcessorClass: TDAScriptProcessorClass; override;
    function GetMetaDataClass: TCRMetaDataClass; override;
    function GetConnectDialogServiceClass: TConnectDialogServiceClass; override;
    function GetDataTypesMap: TDataTypesMapClass; override;
    function GetParamObjectClass(Param: TDAParam): TClass; override;
    function CreateParamObject(Param: TDAParam): TSharedObject; override;

    procedure SetObjectProps(Obj: TObject; Options: TStrings; SetAllProps: boolean); override;

    function GetConnectionOptions: TOptionsList; override;
    function GetSQLOptions: TOptionsList; override;
    function GetDataSetOptions: TOptionsList; override;
    function GetScriptOptions: TOptionsList; override;
  end;

  TOraConnectDialogService = class (TConnectDialogService)
  private
    FDirect: boolean;
  public
    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetConnectMode: integer; override;
  end;

procedure RegisterComponent;

implementation

uses
  TypInfo, DAConsts,
{$IFNDEF UNIDACPRO}
  OraParser, OraConnectionPool, OraClasses, OraServices, OraScriptProcessor;
{$ELSE}
  OraParserUni, OraConnectionPoolUni, OraClassesUni, OraServicesUni, OraScriptProcessorUni;
{$ENDIF}

{ TOracleUniProvider }

class function TOracleUniProvider.GetProviderName: string;
begin
  Result := 'Oracle';
end;

function TOracleUniProvider.NeedRecreateProcCall: boolean;
begin
  Result := True;
end;

function TOracleUniProvider.GetParserClass: TParserClass;
begin
  Result := TOraParser;
end;

function TOracleUniProvider.GetConnectionParametersClass: TCRConnectionParametersClass;
begin
  Result := TOraConnectionParameters;
end;

function TOracleUniProvider.GetConnectionPoolingManagerClass: TCRConnectionPoolManagerClass;
begin
  Result := TOraConnectionPoolManager;
end;

function TOracleUniProvider.GetConnectionClass: TCRConnectionClass;
begin
  Result := TOCIConnection;
end;

function TOracleUniProvider.GetServerEnumeratorClass: TCRServerEnumeratorClass;
begin
  Result := TOraServerEnumerator;
end;

function TOracleUniProvider.GetTransactionClass: TCRTransactionClass;
begin
  Result := TOCITransaction;
end;

function TOracleUniProvider.GetCommandClass: TCRCommandClass;
begin
  Result := TOCICommand;
end;

function TOracleUniProvider.GetRecordSetClass: TCRRecordSetClass;
begin
  Result := TOCIRecordSet;
end;

function TOracleUniProvider.GetDataSetServiceClass: TDADataSetServiceClass;
begin
  Result := TCustomOraDataSetService;
end;

function TOracleUniProvider.GetScriptProcessorClass: TDAScriptProcessorClass;
begin
  Result := TOraScriptProcessor;
end;

function TOracleUniProvider.GetDataTypesMap: TDataTypesMapClass;
begin
  Result := TCustomOraDataTypesMap;
end;

function TOracleUniProvider.GetMetaDataClass: TCRMetaDataClass;
begin
  Result := TOCIMetaData;
end;

function TOracleUniProvider.GetConnectDialogServiceClass: TConnectDialogServiceClass;
begin
  Result := TOraConnectDialogService;
end;

function TOracleUniProvider.GetParamObjectClass(Param: TDAParam): TClass;
begin
  case Param.DataType of
    ftOraClob, ftOraBlob:
      Result := TOraLob;
    ftBlob, ftMemo{$IFDEF VER10P}, ftWideMemo{$ENDIF}:
      Result := TCompressedBlob;
    ftCursor:
      Result := TOraCursor;
  else
    raise Exception.Create(SUnknownDataType);
  end;
end;

function TOracleUniProvider.CreateParamObject(Param: TDAParam): TSharedObject;
begin
  case Param.DataType of
    ftOraClob, ftOraBlob: begin
      Result := TOraLob.Create(nil);
      if Param.DataType = ftOraClob then begin
        if TDBAccessUtils.GetNational(Param) then
          TOraLob(Result).LobType := ltNClob
        else
          TOraLob(Result).LobType := ltClob;
      end
      else
        TOraLob(Result).LobType := ltBlob;
    end;
    ftBlob, ftMemo{$IFDEF VER10P}, ftWideMemo{$ENDIF}: begin
      Result := TCompressedBlob.Create;
    {$IFDEF VER10P}
      if Param.DataType = ftWideMemo then
        TBlob(Result).IsUnicode := True;
    {$ENDIF}
    end;
    ftCursor:
      Result := TOraCursor.Create;
  else
    raise Exception.Create(SUnknownDataType);
  end;
end;

procedure TOracleUniProvider.SetObjectProps(Obj: TObject; Options: TStrings; SetAllProps: boolean);
begin
  if Obj.ClassType = TOCIConnection then begin
  {$IFDEF VER6P}
    TOCIConnection(Obj).SetProp(prEnableSQLTimeStamp, True);
  {$ENDIF}
    TOCIConnection(Obj).SetProp(prIntervalAsString, True);
    GetConnectionOptions.ImportOptions(Options, Obj, TOCIConnection(Obj).SetProp, SetAllProps);
  end
  else
  if Obj.ClassType = TOraConnectionParameters then
    GetConnectionOptions.ImportOptions(Options, Obj, TOraConnectionParameters(Obj).SetProp, SetAllProps)
  else
  if Obj.ClassType = TOraServerEnumerator then
    GetConnectionOptions.ImportOptions(Options, Obj, TOraServerEnumerator(Obj).SetProp, SetAllProps)
  else
  if Obj.ClassType = TOraConnectDialogService then
    GetConnectionOptions.ImportOptions(Options, Obj, TOraConnectDialogService(Obj).SetProp, SetAllProps)
  else
  if Obj.ClassType = TOCICommand then begin
    TOCICommand(Obj).SetProp(prCheckParamHasDefault, False);
    TOCICommand(Obj).SetProp(prUseResultParams, True);
    GetSQLOptions.ImportOptions(Options, Obj, TOCICommand(Obj).SetProp, SetAllProps);
  end
  else
  if Obj.ClassType = TOCIRecordSet then begin
    GetDataSetOptions.ImportOptions(Options, Obj, TOCIRecordSet(Obj).SetProp, SetAllProps);
    GetDataSetOptions.ImportOptions(Options, TOCIRecordSet(Obj).GetCommand, TOCIRecordSet(Obj).GetCommand.SetProp, SetAllProps);
  end
  else
  if Obj.ClassType = TCustomOraDataSetService then
    GetDataSetOptions.ImportOptions(Options, Obj, TCustomOraDataSetService(Obj).SetProp, SetAllProps)
  else
  if Obj.ClassType = TOraScriptProcessor then
    GetScriptOptions.ImportOptions(Options, Obj, TOraScriptProcessor(Obj).SetProp, SetAllProps);
end;

function TOracleUniProvider.GetConnectionOptions: TOptionsList;
begin
  if FConnectionOptions = nil then begin
    FConnectionOptions := TOptionsList.Create(GetProviderName);
    FConnectionOptions.Add(TIntegerOption.Create('CharLength', prCharLength, [TOCIConnection], 1));
    FConnectionOptions.Add(TStringOption.Create('Charset', prCharset, [TOCIConnection], ''));
    FConnectionOptions.Add(TBooleanOption.Create('UseUnicode', prUseUnicode, [TOCIConnection], False));
    FConnectionOptions.Add(TStringOption.Create('DateFormat', prDateFormat, [TOCIConnection], ''));
    FConnectionOptions.Add(TStringOption.Create('DateLanguage', prDateLanguage, [TOCIConnection], ''));
    FConnectionOptions.Add(TBooleanOption.Create('UseOCI7', prUseOCI7, [TOCIConnection, TOraConnectionParameters], False));
    FConnectionOptions.Add(TEnumeratorOption.Create('OptimizerMode', prOptimizerMode, [TOCIConnection], Variant(omDefault), TypeInfo(TOptimizerMode)));
    FConnectionOptions.Add(TIntegerOption.Create('ConnectionTimeout', prConnectionTimeOut, [TOCIConnection, TOraConnectionParameters], 0));
    FConnectionOptions.Add(TBooleanOption.Create('StatementCache', prStatementCache, [TOCIConnection, TOraConnectionParameters], False));
    FConnectionOptions.Add(TIntegerOption.Create('StatementCacheSize', prStatementCacheSize, [TOCIConnection, TOraConnectionParameters], 20));
    FConnectionOptions.Add(TStringOption.Create('ClientIdentifier', prClientIdentifier, [TOCIConnection], ''));
    FConnectionOptions.Add(TBooleanOption.Create('Direct', prDirect, [TOCIConnection, TOraConnectionParameters, TOraServerEnumerator, TOraConnectDialogService], False));
    FConnectionOptions.Add(TEnumeratorOption.Create('ConnectMode', prConnectMode, [TOCIConnection, TOraConnectionParameters], Variant(cmNormal), TypeInfo(TConnectMode)));
    FConnectionOptions.Add(TBooleanOption.Create('ThreadSafety', prThreadSafety, [TOCIConnection], True));
    FConnectionOptions.Add(TStringOption.Create('HomeName', prHomeName, [TOCIConnection, TOraConnectionParameters, TOraServerEnumerator], ''));
    FConnectionOptions.Add(TStringOption.Create('Schema', prSchema, [TOCIConnection], ''));
    FConnectionOptions.Add(TEnumeratorOption.Create('PoolingType', prPoolingType, [TOraConnectionParameters], Variant(optLocal), TypeInfo(TOraPoolingType)));
    FConnectionOptions.Add(TIntegerOption.Create('PrecisionSmallint', prSmallintPrecision, [TOCIConnection], 4));
    FConnectionOptions.Add(TIntegerOption.Create('PrecisionInteger', prIntegerPrecision, [TOCIConnection], 9));
    FConnectionOptions.Add(TIntegerOption.Create('PrecisionLargeint', prLargeintPrecision, [TOCIConnection], 18));
    FConnectionOptions.Add(TIntegerOption.Create('PrecisionFloat', prFloatPrecision, [TOCIConnection], 0));
    FConnectionOptions.Add(TStringOption.Create('PrecisionBCD', prBCDPrecision, [TOCIConnection], '14,4'));
    FConnectionOptions.Add(TStringOption.Create('PrecisionFMTBCD', prFMTBCDPrecision, [TOCIConnection], '38,38'));
  end;
  Result := FConnectionOptions;
end;

function TOracleUniProvider.GetSQLOptions: TOptionsList;
begin
  if FSQLOptions = nil then begin
    FSQLOptions := ToptionsList.Create(GetProviderName);
    FSQLOptions.Add(TBooleanOption.Create('StatementCache', prStatementCache, [TOCICommand], False));
    FSQLOptions.Add(TBooleanOption.Create('TemporaryLobUpdate', prTemporaryLobUpdate, [TOCICommand], True));
  end;
  Result := FSQLOptions;
end;

function TOracleUniProvider.GetDataSetOptions: TOptionsList;
begin
  if FDataSetOptions = nil then begin
    FDataSetOptions := TOptionsList.Create(GetProviderName);
    FDataSetOptions.Add(TBooleanOption.Create('FetchAll', prFetchAll, [TOCIRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('AutoClose', prAutoClose, [TOCIRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('FieldsAsString', prFieldsAsString, [TOCICommand], False));
    FDataSetOptions.Add(TBooleanOption.Create('DeferredLobRead', prDeferredLobRead, [TOCIRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('CacheLobs', prCacheLobs, [TOCICommand], True));
    FDataSetOptions.Add(TBooleanOption.Create('ScrollableCursor', prScrollableCursor, [TOCICommand], False));
    FDataSetOptions.Add(TBooleanOption.Create('RawAsString', prRawAsString, [TOCICommand], False));
    FDataSetOptions.Add(TBooleanOption.Create('TemporaryLobUpdate', prTemporaryLobUpdate, [TOCICommand], True));
    FDataSetOptions.Add(TBooleanOption.Create('StatementCache', prStatementCache, [TOCICommand], False));
    FDataSetOptions.Add(TBooleanOption.Create('ExtendedFieldsInfo', prExtendedFieldsInfo, [TCustomOraDataSetService], False));
    FDataSetOptions.Add(TStringOption.Create('KeySequence', prKeySequence, [TCustomOraDataSetService], ''));
    FDataSetOptions.Add(TEnumeratorOption.Create('SequenceMode', prSequenceMode, [TCustomOraDataSetService], Variant(_smPost), TypeInfo(_TSequenceMode)));
  end;
  Result := FDataSetOptions;
end;

function TOracleUniProvider.GetScriptOptions: TOptionsList;
begin
  if FScriptOptions = nil then begin
    FScriptOptions := TOptionsList.Create(GetProviderName);
  end;
  Result := FScriptOptions;
end;

{ TOraConnectDialogService }

function TOraConnectDialogService.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prDirect:
      FDirect := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TOraConnectDialogService.GetConnectMode: integer;
begin
  if FDirect then
    Result := 2
  else
    Result := 1;
end;

procedure RegisterComponent;
begin
  RegisterComponents('UniDAC', [TOracleUniProvider]);
end;

initialization
  UniProviders.RegisterProvider(TOracleUniProvider);

finalization
  UniProviders.UnRegisterProvider(TOracleUniProvider);  

end.