interbaseuniprovider.pas

来自「CrLab UniDAC 1.0 include sources」· PAS 代码 · 共 287 行

{$IFNDEF CLR}

{$I IbDac.inc}

unit InterBaseUniProvider;
{$ENDIF}



interface

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

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

    function IsDatabaseSupported: boolean; override;
    function IsDataSetNeedTransaction: boolean; override;
    function IsInOutParamSupported: boolean; override;
    function NeedRecreateProcCall: boolean; override;
    function NeedReparseSQL: 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;

  TIBCConnectDialogService = class (TConnectDialogService)
  public
    function UseDatabaseHistory: boolean; override;
  end;

procedure RegisterComponent;

implementation

uses
  DAConsts,
{$IFDEF VER6P}
  Variants,
{$ENDIF}
{$IFNDEF UNIDACPRO}
  IBCServices, IBCClasses, IBCConnectionPool, IBCScriptProcessor, IBCParser;
{$ELSE}
  IBCServicesUni, IBCClassesUni, IBCConnectionPoolUni, IBCScriptProcessorUni, IBCParserUni;
{$ENDIF}

{ TInterBaseUniProvider }

class function TInterBaseUniProvider.GetProviderName: string;
begin
  Result := 'InterBase';
end;

function TInterBaseUniProvider.IsDatabaseSupported: boolean;
begin
  Result := True;
end;

function TInterBaseUniProvider.IsDataSetNeedTransaction: boolean;
begin
  Result := True;
end;

function TInterBaseUniProvider.IsInOutParamSupported: boolean;
begin
  Result := False;
end;

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

function TInterBaseUniProvider.NeedReparseSQL: boolean;
begin
  Result := True;
end;

function TInterBaseUniProvider.GetParserClass: TParserClass;
begin
  Result := TIBCParser;
end;

function TInterBaseUniProvider.GetConnectionParametersClass: TCRConnectionParametersClass;
begin
  Result := TIBCConnectionParameters;
end;

function TInterBaseUniProvider.GetConnectionPoolingManagerClass: TCRConnectionPoolManagerClass;
begin
  Result := TIBCConnectionPoolManager;
end;

function TInterBaseUniProvider.GetConnectionClass: TCRConnectionClass;
begin
  Result := TGDSConnection;
end;

function TInterBaseUniProvider.GetServerEnumeratorClass: TCRServerEnumeratorClass;
begin
  Result := TIBCServerEnumerator;
end;

function TInterBaseUniProvider.GetTransactionClass: TCRTransactionClass;
begin
  Result := TGDSTransaction;
end;

function TInterBaseUniProvider.GetCommandClass: TCRCommandClass;
begin
  Result := TGDSCommand;
end;

function TInterBaseUniProvider.GetRecordSetClass: TCRRecordSetClass;
begin
  Result := TGDSRecordSet;
end;

function TInterBaseUniProvider.GetDataSetServiceClass: TDADataSetServiceClass;
begin
  Result := TCustomIBCDataSetService;
end;

function TInterBaseUniProvider.GetScriptProcessorClass: TDAScriptProcessorClass;
begin
  Result := TCustomIBCScriptProcessor;
end;

function TInterBaseUniProvider.GetMetaDataClass: TCRMetaDataClass;
begin
  Result := TGDSMetaData;
end;

function TInterBaseUniProvider.GetConnectDialogServiceClass: TConnectDialogServiceClass;
begin
  Result := TIBCConnectDialogService;
end;

function TInterBaseUniProvider.GetDataTypesMap: TDataTypesMapClass;
begin
  Result := TCustomIBCDataTypesMap;
end;

function TInterBaseUniProvider.GetParamObjectClass(Param: TDAParam): TClass;
begin
  case Param.DataType of
    ftBlob, ftMemo{$IFDEF VER10P}, ftWideMemo{$ENDIF}:
      Result := TIBCBlob;
  else
    raise Exception.Create(SUnknownDataType);
  end;
end;

function TInterBaseUniProvider.CreateParamObject(Param: TDAParam): TSharedObject;
begin
  case Param.DataType of
    ftBlob, ftMemo{$IFDEF VER10P}, ftWideMemo{$ENDIF}: begin
      Result := TIBCBlob.Create(nil, nil);
    end
  else
    raise Exception.Create(SUnknownDataType);
  end;
end;

procedure TInterBaseUniProvider.SetObjectProps(Obj: TObject; Options: TStrings; SetAllProps: boolean);
begin
  if Obj.ClassType = TGDSConnection then begin
    TGDSConnection(Obj).SetProp(prSimpleNumericMap, True);
    TGDSConnection(Obj).SetProp(prEnableMemos, True);
    GetConnectionOptions.ImportOptions(Options, Obj, TGDSConnection(Obj).SetProp, SetAllProps);
  end
  else
  if Obj.ClassType = TIBCConnectionParameters then
    GetConnectionOptions.ImportOptions(Options, Obj, TIBCConnectionParameters(Obj).SetProp, SetAllProps)
  else
  if Obj.ClassType = TGDSCommand then
    GetSQLOptions.ImportOptions(Options, Obj, TGDSCommand(Obj).SetProp, SetAllProps)
  else
  if Obj.ClassType = TGDSRecordSet then begin
    GetDataSetOptions.ImportOptions(Options, Obj, TGDSRecordSet(Obj).SetProp, SetAllProps);
    GetDataSetOptions.ImportOptions(Options, TGDSRecordSet(Obj).GetCommand, TGDSRecordSet(Obj).GetCommand.SetProp, SetAllProps);
  end
  else
  if Obj.ClassType = TCustomIBCDataSetService then
    GetDataSetOptions.ImportOptions(Options, Obj, TCustomIBCDataSetService(Obj).SetProp, SetAllProps)
  else
  if Obj.ClassType = TCustomIBCScriptProcessor then
    GetScriptOptions.ImportOptions(Options, Obj, TCustomIBCScriptProcessor(Obj).SetProp, SetAllProps);
end;

function TInterBaseUniProvider.GetConnectionOptions: TOptionsList;
begin
  if FConnectionOptions = nil then begin
    FConnectionOptions := TOptionsList.Create(GetProviderName);
    FConnectionOptions.Add(TIntegerOption.Create('CharLength', prCharLength, [TGDSConnection], 0));
    FConnectionOptions.Add(TStringOption.Create('Charset', prCharset, [TGDSConnection, TIBCConnectionParameters], ''));
    FConnectionOptions.Add(TStringOption.Create('Role', prRole, [TGDSConnection, TIBCConnectionParameters], ''));
    FConnectionOptions.Add(TBooleanOption.Create('UseUnicode', prUseUnicode, [TGDSConnection, TIBCConnectionParameters], False));
    FConnectionOptions.Add(TIntegerOption.Create('SQLDialect', prSQLDialect, [TGDSConnection, TIBCConnectionParameters], 3));
    FConnectionOptions.Add(TStringOption.Create('ClientLibrary', prClientLibrary, [TGDSConnection], ''));
    FConnectionOptions.Add(TEnumeratorOption.Create('Protocol', prProtocol, [TGDSConnection, TIBCConnectionParameters], Variant(_TCP), TypeInfo(_TIBCProtocol)));
  end;
  Result := FConnectionOptions;
end;

function TInterBaseUniProvider.GetSQLOptions: TOptionsList;
begin
  if FSQLOptions = nil then begin
    FSQLOptions := TOptionsList.Create(GetProviderName);
  end;
  Result := FSQLOptions;
end;

function TInterBaseUniProvider.GetDataSetOptions: TOptionsList;
begin
  if FDataSetOptions = nil then begin
    FDataSetOptions := TOptionsList.Create(GetProviderName);
    FDataSetOptions.Add(TBooleanOption.Create('FetchAll', prFetchAll, [TGDSRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('AutoClose', prAutoClose, [TGDSRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('FieldsAsString', prFieldsAsString, [TGDSRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('DeferredBlobRead', prDeferredBlobRead, [TGDSRecordSet], False));
    FDataSetOptions.Add(TBooleanOption.Create('CacheBlobs', prCacheBlobs, [TGDSCommand], True));
    FDataSetOptions.Add(TBooleanOption.Create('StreamedBlobs', prStreamedBlobs, [TGDSCommand], False));
    FDataSetOptions.Add(TBooleanOption.Create('ComplexArrayFields', prComplexArrayFields, [TGDSRecordSet], True));
    FDataSetOptions.Add(TBooleanOption.Create('DeferredArrayRead', prDeferredArrayRead, [TGDSRecordSet], True));
    FDataSetOptions.Add(TBooleanOption.Create('CacheArrays', prCacheArrays, [TGDSCommand], True));
    FDataSetOptions.Add(TStringOption.Create('KeyGenerator', prKeyGenerator, [TCustomIBCDataSetService], ''));
    FDataSetOptions.Add(TEnumeratorOption.Create('GeneratorMode', prGeneratorMode, [TCustomIBCDataSetService], Variant(_gmPost), TypeInfo(_TGeneratorMode)));
    FDataSetOptions.Add(TStringOption.Create('GeneratorStep', prGeneratorStep, [TCustomIBCDataSetService], 1));
  end;
  Result := FDataSetOptions;
end;

function TInterBaseUniProvider.GetScriptOptions: TOptionsList;
begin
  if FScriptOptions = nil then begin
    FScriptOptions := TOptionsList.Create(GetProviderName);
    FScriptOptions.Add(TBooleanOption.Create('AutoDDL', prAutoDDL, [TCustomIBCScriptProcessor], True));
  end;
  Result := FScriptOptions;
end;

{ TIBCConnectDialogService }

function TIBCConnectDialogService.UseDatabaseHistory: boolean;
begin
  Result := True;
end;

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

initialization
  UniProviders.RegisterProvider(TInterBaseUniProvider);

finalization
  UniProviders.UnRegisterProvider(TInterBaseUniProvider);

end.