oraservicesuni.pas

来自「CrLab UniDAC 1.0 include sources」· PAS 代码 · 共 1,991 行 · 第 1/5 页

//////////////////////////////////////////////////
//  Oracle Data Access Components
//  Copyright (c) 1998-2008 Core Lab. All right reserved.
//////////////////////////////////////////////////

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

{$I Odac.inc}

interface

uses
  SysUtils, Classes, DB,
{$IFDEF CLR}
  System.Text,
{$ELSE}
  CLRClasses,
{$ENDIF}
{$IFDEF VER6P}
  Variants,
{$ENDIF}
  MemData, CRAccess, MemDS, DBAccess;

const
  prKeySequence        = 101; // string
  prSequenceMode       = 102; // integer
  prExtendedFieldsInfo = 103; // boolean
  prTNSPath            = 104; // string

type
  TCustomOraDataSetUpdater = class;
  TCustomOraDataSetService = class;

  // must be sync with types in Ora
  _TSequenceMode = (_smInsert, _smPost);

  TCustomOraDataTypesMap = class(TDataTypesMap)
    class function GetDataType(FieldType: TFieldType): integer; override;
    class function GetFieldType(DataType: Word): TFieldType; override;
  end;

  TCustomOraSQLGenerator = class(TDASQLGenerator)
  protected
    FDataSetService: TCustomOraDataSetService;

    FSeqReturning: boolean;
    FSeqFieldDesc: TCRFieldDesc;
  protected
    FReturnSB,
    FIntoSB: StringBuilder;

    function IsBlobDataType(DataType: word): boolean; override;
    function IsObjectDataType(DataType: word): boolean; override;
    function FieldIsNull(FieldDesc: TCRFieldDesc; OldValue: boolean; Data: TData; OldRecBuf, NewRecBuf: IntPtr): boolean; override;

    function GenerateIndexName(Name: string): string; override;

    function IsSubstituteParamName: boolean; override;
    procedure AddParam(SB: StringBuilder; FieldDesc: TFieldDesc;
      const StatementType: TStatementType;
      const ParamType: TParamType;
      Index: integer = -1;
      Old: boolean = False); override;

    procedure AddFieldToInsertSQL(FieldDesc: TCRFieldDesc; const Index: integer = -1); override;

    procedure AddFieldToUpdateSQL(FieldDesc: TCRFieldDesc;
      const ModifiedFieldsOnly: boolean;
      const Index: integer = -1); override;

    procedure GenerateInsertSQL(
      const KeyAndDataFields: TKeyAndDataFields;
      const ModifiedFieldsOnly: boolean;
      const Index: integer = -1); override;

    procedure GenerateUpdateSQL(
      const KeyAndDataFields: TKeyAndDataFields;
      const ModifiedFieldsOnly: boolean;
      const Index: integer = -1); override;

    procedure GenerateRefreshSQL(
      const KeyAndDataFields: TKeyAndDataFields;
      const ModifiedFieldsOnly: boolean); override;

    procedure GenerateLockSQL(
      const KeyAndDataFields: TKeyAndDataFields;
      const Index: integer = -1); override;
  public
    constructor Create(Owner: TDADataSetService); override;

    function GenerateSQL(const StatementType: TStatementType;
      const ModifiedFieldsOnly: boolean;
      Params: TDAParams;
      const Index: Integer = -1): string; override;

    function GenerateTableSQL(const TableName, OrderFields: string): string; override;
    function GenerateSelectValues(const ValuesList: string): string; override;
  end;

  TCustomOraDataSetUpdater = class(TDADataSetUpdater)
  protected
    FDataSetService: TCustomOraDataSetService;

    procedure GetSequenceNextVal;
    function GetIdentityFieldValue(var Value: variant): boolean; override;

    function IsNeedInsertPreconnect: boolean; override;
    function IsNeedEditPreconnect: boolean; override;
    function IsPreconnected: boolean; override;
    function NeedReturnParams: boolean; override;
    function RefreshAfterInsertAllowed: boolean; override;

    function PrepareBatch(SQL: string): string; override;

    procedure CheckUpdateQuery(const StatementType: TStatementType); override;
    procedure SetUpdateQueryOptions(const StatementType: TStatementType); override;
    procedure UpdateExecute(const StatementTypes: TStatementTypes); override;

    procedure PrepareAppend; override;
    function PerformAppend: boolean; override;

    property UpdateQuery: TComponent read FUpdateQuery;
  public
    constructor Create(AOwner: TDataSetService); override;

    function PerformSQL(const SQL: string; const StatementTypes: TStatementTypes): boolean; override;
  end;

  TCustomOraDataSetService = class(TDADataSetService)
  protected
    FFieldsInfoRequested: boolean;
    FUpdater: TCustomOraDataSetUpdater;

    FKeySequence: string;
    FSequenceMode: _TSequenceMode;
    FExtendedFieldsInfo: boolean;
    FScrollableCursor: boolean;

    function GetTemporaryLobUpdate: boolean;

    procedure CreateDataSetUpdater; override;
    procedure SetDataSetUpdater(Value: TDataSetUpdater); override;
    procedure CreateSQLGenerator; override;

    procedure InitCursor; override;
    procedure InitUpdatingTable(AdjustFields: boolean = True); override;

    procedure FillFieldsDefaultValues; override;
    procedure FillFieldsOrigin; override;

    function DetectIdentityField: TField; override;
    function DetectKeyGeneratorField: TField; override;
    function DetectHiddenFields: TFieldArray; override;
    function DetectCanModify: boolean; override;

    procedure FillDataFieldDescs(out DataFieldDescs: TFieldDescArray; ForceUseAllKeyFields: boolean); override; //TODO: Add support for ForceUseAllKeyFields

    // this function is used for filling DataFielDesc(ExtendedFieldsInfo), FillFieldsDefaulValues,
    // FillFieldsOrigin
    procedure GetFieldsInfo;

    function GetRecCount: integer; override;
    function GetIRecordSet: TCRRecordSet;
    function UsedConnection: TCustomDAConnection;
    function IsFullRefresh: boolean;
    function IsDMLRefresh: boolean;
    function IsInCacheProcessing: boolean;
    function GetKeyFields: string;
    function IsAutoCommit: boolean;

    function CompatibilityMode: boolean; virtual;
    function GetFieldClass(FieldType: TFieldType): TFieldClass; override;

    property KeyGeneratorField: TField read FKeyGeneratorField;
  public
    function SetProp(Prop: integer; const Value: variant): boolean; override;

    function OpenNext: boolean; override;
  end;

  TOraServerEnumerator = class (TCRServerEnumerator)
  private
    FDirect: boolean;
    FHomeName: string;
    FTNSPath: string;

  public
    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; var Value: variant): boolean; override;

    procedure GetServerList(List: TStrings); override;
  end;

implementation

uses
{$IFDEF MSWINDOWS}
  Registry, Windows,
{$ENDIF}
  MemUtils, DAConsts, DASQLMonitor, CRParser,
{$IFNDEF UNIDACPRO}
  OraCall, OraClasses, OraParser;
{$ELSE}
  OraCallUni, OraClassesUni, OraParserUni;
{$ENDIF}

{ TCustomOraDataTypesMap }

const
{$IFDEF VER5}
  OraDataTypeMap: array [TFieldType] of word = (
    dtUnknown, dtString, dtInteger, dtInteger, dtInteger, dtBoolean, dtFloat,
    dtFloat, dtUnknown, dtDateTime, dtDateTime, dtDateTime, dtBytes, dtVarBytes, 0, dtBlob, dtMemo,
    0, 0, 0, 0, 0, dtCursor, dtFixedChar, dtWideString, dtInteger, dtObject, dtArray, dtReference,
    dtTable, dtOraBlob, dtOraClob, 0, 0, 0, 0);
{$ENDIF}
{$IFDEF VER6P}
  OraDataTypeMap: array [TFieldType] of word = (
    dtUnknown, dtString, dtInteger, dtInteger, dtInteger, dtBoolean, dtFloat,
    dtFloat, dtUnknown, dtDateTime, dtDateTime, dtDateTime, dtBytes, dtVarBytes, 0, dtBlob, dtMemo,
    0, 0, 0, 0, 0, dtCursor, dtFixedChar, dtWideString, dtLargeInt, dtObject, dtArray, dtReference,
    dtTable, dtOraBlob, dtOraClob, 0, 0, 0, 0, dtSQLTimeStamp, dtFMTBcd
    {$IFDEF VER10P}, dtFixedWideChar, dtWideMemo, dtTimeStamp, 0{$ENDIF});
{$ENDIF}

class function TCustomOraDataTypesMap.GetDataType(FieldType: TFieldType): integer;
begin
{$IFNDEF VER10P}
  if Integer(FieldType) = Integer(ftFixedWideChar) then
    Result := dtFixedWideChar
  else
{$ENDIF}
    Result := OraDataTypeMap[FieldType];
end;

class function TCustomOraDataTypesMap.GetFieldType(DataType: Word): TFieldType;
begin
  case DataType of
    dtOraBlob:
      Result := ftOraBlob;
    dtOraClob, dtWideOraClob:
      Result := ftOraClob;
    dtFixedChar:
      Result := ftFixedChar;
    dtFixedWideChar:
      Result := TFieldType(ftFixedWideChar);
    dtCursor:
      Result := ftCursor;
  {$IFDEF VER6P}
    dtSQLTimeStamp:
      Result := ftTimeStamp;
  {$ENDIF}
    dtUndefined, dtTimeStamp, dtTimeStampTZ, dtTimeStampLTZ, dtBFile, dtLabel,
    dtIntervalYM, dtIntervalDS, dtNumber, dtXML:
      Result := ftUnknown;
  else
    Result := inherited GetFieldType(DataType);
  end;
end;

{ TCustomOraSQLGenerator }

constructor TCustomOraSQLGenerator.Create(Owner: TDADataSetService);
begin
  inherited Create(Owner);

  FDataSetService := TCustomOraDataSetService(Owner);
end;

function TCustomOraSQLGenerator.IsBlobDataType(DataType: word): boolean;
begin
  Result := DataType in [dtBlob, dtMemo, dtWideMemo, dtOraClob, dtWideOraClob, dtOraBlob];
end;

function TCustomOraSQLGenerator.IsObjectDataType(DataType: word): boolean;
begin
  Result := inherited IsObjectDataType(DataType) or (DataType = dtTable);
end;

function TCustomOraSQLGenerator.FieldIsNull(FieldDesc: TCRFieldDesc; OldValue: boolean;
  Data: TData; OldRecBuf, NewRecBuf: IntPtr): boolean;
begin
  if FieldDesc = FSeqFieldDesc then
    Result := False
  else
    Result := inherited FieldIsNull(FieldDesc, OldValue, Data, OldRecBuf, NewRecBuf);
end;

function TCustomOraSQLGenerator.GenerateIndexName(Name: string): string;
begin
  Result := '"' + '_' + Name + '"';
end;

function TCustomOraSQLGenerator.IsSubstituteParamName: boolean;
begin
  Result := False;
end;

procedure TCustomOraSQLGenerator.AddParam(SB: StringBuilder; FieldDesc: TFieldDesc;
  const StatementType: TStatementType; const ParamType: TParamType; Index: integer = -1;
  Old: boolean = False);
var
  IdentityField: TField;
begin
  IdentityField := FDataSetService.IdentityField;
  if IdentityField <> nil then
    if FDataSet.GetFieldDesc(IdentityField) = FieldDesc then
      Old := True;

  inherited AddParam(SB, FieldDesc, StatementType, ParamType, Index, Old);   
end;

procedure TCustomOraSQLGenerator.AddFieldToInsertSQL(FieldDesc: TCRFieldDesc; const Index: integer = -1);

  procedure AddComma;
  begin
    if FFldSB.Length > 0 then begin
      FFldSB.Append(', ');
      FFldParamSB.Append(', ');
    end;
  end;

var
  RecordSet: TOCIRecordSet;
begin
  RecordSet := TOCIRecordSet(FDataSetService.GetIRecordSet);
  if (FieldDesc.DataType = dtOraBlob) and not (FDataSetService.GetTemporaryLobUpdate) then begin
    AddComma;
    FFldSB.Append(FieldDesc.ActualNameQuoted(RecordSet, FDataSet.Options.QuoteNames));
    FFldParamSB.Append('EMPTY_BLOB()');
  end
  else
  if (FieldDesc.DataType in [dtOraClob, dtWideOraClob]) and not (FDataSetService.GetTemporaryLobUpdate) then begin
    AddComma;
    FFldSB.Append(FieldDesc.ActualNameQuoted(RecordSet, FDataSet.Options.QuoteNames));
    FFldParamSB.Append('EMPTY_CLOB()');
  end
  else
  if FSeqReturning and (FieldDesc = FSeqFieldDesc) then begin
    AddComma;
    FFldSB.Append(FieldDesc.ActualNameQuoted(RecordSet, FDataSet.Options.QuoteNames));
    FFldParamSB.Append(FDataSetService.FKeySequence + '.NEXTVAL');
  end
  else
    inherited;
end;

procedure TCustomOraSQLGenerator.GenerateInsertSQL(const KeyAndDataFields: TKeyAndDataFields;
  const ModifiedFieldsOnly: boolean; const Index: integer = -1);
var
  Sequenced: boolean;
  FieldDesc: TCRFieldDesc;
  LobReturning: boolean;
  i: integer;

  ReturnSB: StringBuilder;
  IntoSB: StringBuilder;

  UsedConnection: TCustomDAConnection;
  RecordSet: TOCIRecordSet;
begin
  Sequenced := (FDataSetService.KeyGeneratorField <> nil) and (FDataSetService.FSequenceMode = _smPost);

  if Sequenced then begin
    UsedConnection := FDataSetService.UsedConnection;
    with TOCIConnection(TDBAccessUtils.GetIConnection(UsedConnection)) do
      FSeqReturning := (GetOCICallStyle = OCI80) and (GetOracleVersion >= 8000);

    FSeqFieldDesc := KeyAndDataFields.KeyFieldDescs[0];
    if not FSeqReturning then begin
      FHeaderSB.Append('begin'#$D#$A'  SELECT ');
      FHeaderSB.Append(FDataSetService.FKeySequence);
      FHeaderSB.Append('.NEXTVAL INTO ');
      AddParam(FHeaderSB, FSeqFieldDesc, stInsert, Index);
      FHeaderSB.Append(' FROM Dual;' + #$D#$A#$D#$A + '  ');
    end;
  end;

  ReturnSB := StringBuilder.Create(100);
  IntoSB := StringBuilder.Create(100);
  try
    LobReturning := False;
    if not FDataSetService.GetTemporaryLobUpdate then
      for i := 0 to High(KeyAndDataFields.DataFieldDescs) do
        if KeyAndDataFields.DataFieldDescs[i].DataType in [dtOraBlob, dtOraClob, dtWideOraClob] then
          LobReturning := True;

    inherited GenerateInsertSQL(KeyAndDataFields, ModifiedFieldsOnly, Index);

    if FFldSB.Length = 0 then begin
      Clear;
      inherited GenerateInsertSQL(KeyAndDataFields, False, Index);
    end;

    if FDataSetService.IsDMLRefresh or LobReturning or Sequenced then begin