oraservicesuni.pas

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

  PropValue: Variant; 
begin
  GetIRecordSet.GetCommand.GetProp(prTemporaryLobUpdate, PropValue);
  Result := PropValue;
end;

procedure TCustomOraDataSetService.InitCursor;
begin
  inherited;
end;

procedure TCustomOraDataSetService.InitUpdatingTable(AdjustFields: boolean = True);
begin
  FFieldsInfoRequested := False;

  inherited;
end;

procedure TCustomOraDataSetService.FillFieldsDefaultValues;
begin
  GetFieldsInfo;
end;

procedure TCustomOraDataSetService.FillFieldsOrigin;
begin
  GetFieldsInfo;
end;

function TCustomOraDataSetService.DetectIdentityField: TField;
var
  i: integer;
  FieldDesc: TCRFieldDesc;
  RecordSet: TOCIRecordSet;
begin
  GetFieldsInfo;

  Result := nil;
  //Search Identity Field
  RecordSet := TOCIRecordSet(GetIRecordSet);
  for i := 0 to RecordSet.FieldCount - 1 do begin
    FieldDesc := TCRFieldDesc(RecordSet.Fields[i]);
    if CompareText(FieldDesc.ActualName, 'ROWID') = 0 then
      if TCRFieldDesc(FieldDesc).TableInfo = UpdatingTableInfo then begin
        Result := FDataSet.GetField(FieldDesc);
        break;
      end;
  end;
end;

function TCustomOraDataSetService.DetectKeyGeneratorField: TField;
var
  FieldName: string;
  Pos: integer;
begin
  if (Trim(FKeySequence) <> '') and (GetKeyFields <> '') then begin
    Pos := 1;
    FieldName := ExtractFieldName(GetKeyFields, Pos);
    Result := FDataSet.FindField(FieldName);
  end
  else
    Result := nil;
end;

function TCustomOraDataSetService.DetectHiddenFields: TFieldArray;
var
  i: integer;
  FieldDesc: TCRFieldDesc;
  RecordSet: TOCIRecordSet;
  Field: TField;
begin
  Result := nil;
  RecordSet := TOCIRecordSet(GetIRecordSet);
  for i := 0 to RecordSet.FieldCount - 1 do begin
    FieldDesc := TCRFieldDesc(RecordSet.Fields[i]);
    if CompareText(FieldDesc.ActualName, 'ROWID') = 0 then begin
      Field := FDataSet.GetField(FieldDesc);
      if Field <> nil then begin
        SetLength(Result, Length(Result) + 1);
        Result[Length(Result) - 1] := Field;
      end;
    end;
  end;
end;

function TCustomOraDataSetService.DetectCanModify: boolean;
begin
  Result := (inherited DetectCanModify or
    not FDataSet.ReadOnly and
    (not CompatibilityMode or
    (FDataSet.SQLInsert.Count > 0) or
    (FDataSet.SQLUpdate.Count > 0) or
    (FDataSet.SQLDelete.Count > 0)) and
     FIsAnyFieldCanBeModified) and
    not (FScrollableCursor); // can't modify scrollable cursor
end;

function TCustomOraDataSetService.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prKeySequence:
      FKeySequence := Value;
    prSequenceMode:
      FSequenceMode := _TSequenceMode(Value);
    prExtendedFieldsInfo:
      FExtendedFieldsInfo := Value;
    prScrollableCursor:
      FScrollableCursor := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end; 
end;

function TCustomOraDataSetService.OpenNext: boolean;
var
  Cursor: TCRCursor;
begin
  if not FDataSet.Active then begin
    FDataSet.Open;
    Result := True;
  end
  else begin
    Cursor := TOCICommand(GetIRecordSet.GetCommand).GetNextCursor;
    if Cursor <> nil then begin
      FDataSet.Close;
      TDBAccessUtils.SetCursor(FDataSet, Cursor);
      FDataSet.Open;
      Result := True;
    end
    else
      Result := False;
  end;
end;

procedure TCustomOraDataSetService.FillDataFieldDescs(out DataFieldDescs: TFieldDescArray;
  ForceUseAllKeyFields: boolean);
var
  i: integer;
  RecordSet: TOCIRecordSet;
  Field: TField;
  FieldDesc: TCRFieldDesc;
begin
  GetFieldsInfo;

  for i := 0 to FDataSet.FieldCount - 1 do begin
    Field := FDataSet.Fields[i];
    if (Field.FieldKind <> fkData) or (Field = FIdentityField)  then
      Continue;
    FieldDesc := TCRFieldDesc(FDataSet.GetFieldDesc(Field));

    if (FieldDesc.TableInfo <> UpdatingTableInfo) or (FieldDesc.TableInfo = nil) then
      Continue;

    if (FieldDesc.ParentField = nil) and not FieldDesc.ReadOnly then begin
      SetLength(DataFieldDescs, Length(DataFieldDescs) + 1);
      DataFieldDescs[High(DataFieldDescs)] := FieldDesc;
    end;
  end;

  if not FDataSet.ObjectView then begin
    RecordSet := TOCIRecordSet(GetIRecordSet);
    for i := 0 to RecordSet.Fields.Count - 1 do begin
      FieldDesc := TCRFieldDesc(RecordSet.Fields[i]);

      if not (((FieldDesc.DataType = dtObject) or (FieldDesc.DataType = dtArray)) and (FieldDesc.ParentField = nil)) then
        Continue;

      if FieldDesc.TableInfo = nil then
        FieldDesc.TableInfo := UpdatingTableInfo;

      if not FieldDesc.ReadOnly and (FieldDesc.TableInfo = UpdatingTableInfo) then begin
        SetLength(DataFieldDescs, Length(DataFieldDescs) + 1);
        DataFieldDescs[High(DataFieldDescs)] := FieldDesc;
      end;
    end;
  end;
end;

type
  TColumnInfo = class
    Name: string;
    Table: string;
    TableIndex: Integer; //TODO: ref on TCRTableInfo
    Expr: string; // expression
    Alias: string;
    Used: boolean; // is ColumnInfo used by another Field
    Described: boolean;
  end;
  TColumnsInfo = array of TColumnInfo;

function GetColumnsInfo(SQL: string; var ColumnsInfo: TColumnsInfo): integer;
var
  Parser: TOraParser;
  St, PrevSt, Name, Table, Expr, Alias: string;
  Code, PrevCode: integer;
  BracketCount: integer;
  IsExpr: boolean;
begin
  Result := 0;

  Parser := TOraParser.Create(PChar(SQL));
  try
    Parser.OmitComment := True;
    if Parser.ToLexem(lxSELECT) = lxSELECT then begin
      Name := '';
      Table := '';
      Alias := '';
      Expr := '';
      IsExpr := False;
      BracketCount := 0;
      Code := 0;
      repeat
        PrevCode := Code;
        PrevSt := St;
        Code := Parser.GetNext(St);

      /// keywords after SELECT
        if (St = 'ALL') or (St = 'DISTINCT') or (St = 'UNIQUE') then
          Continue;

        if ((Code = lcIdent) or (St = '*')) and not IsExpr then begin
          Name := St;
          Code := Parser.GetNext(St);
          if St = '.' then begin
            Code := Parser.GetNext(St);
            if (Code = lcIdent) or (St = '*') then begin
              Table := Name;
              Name := St;
              Code := Parser.GetNext(St);
              if St = '.' then begin
                Code := Parser.GetNext(St);
                if (Code = lcIdent) or (St = '*') then begin
                  Table := Table + '.' + Name;
                  Name := St;
                  Code := Parser.GetNext(St);
                end;
              end;
            end;
          end;

          if Code = lxAS then
            Code := Parser.GetNext(St);

          if Code = lcIdent then begin
            Alias := St;
            Code := Parser.GetNext(St);
          end;
        end;

        if ((St = ',') or (Code = lxFROM)) and (BracketCount = 0) or (Code = lcEnd) then begin
          if not isExpr and ((Name = 'NULL') or (Name = 'SYSDATE')
            or (Name = 'USER') or (Name = 'UID'))
          then begin
            IsExpr := True;
            Expr := name;
          end;

        // add column
          if Result >= Length(ColumnsInfo) then
            SetLength(ColumnsInfo, Length(ColumnsInfo) + 200);
          ColumnsInfo[Result] := TColumnInfo.Create;
          if not IsExpr then begin
            ColumnsInfo[Result].Name := TOCITableInfo.NormalizeName(Name, False, True);
            ColumnsInfo[Result].Table := TOCITableInfo.NormalizeName(Table, False, True);
          end
          else
            ColumnsInfo[Result].Expr := Expr;

          ColumnsInfo[Result].Alias := TOCITableInfo.NormalizeName(Alias, False, True);

          Inc(Result);
          if St = ',' then begin
            Name := '';
            Table := '';
            Alias := '';
            Expr := '';
            IsExpr := False;
          end
          else
            break;
        end
        else begin
          if not IsExpr then begin
            Expr := Name;
            if Table = '' then
              Expr := Name
            else
              Expr := Table + '.' + Name;
            Alias := '';
            IsExpr := True;
          end
          else
            if Alias <> '' then
              Expr := Expr + Alias;

          if St = '(' then
            Inc(BracketCount)
          else
            if St = ')'then
              Dec(BracketCount);

          if Code = lxAS then
            Continue;

          if (BracketCount = 0) and (Code = lcIdent) and
           ((PrevCode = lcIdent) or (PrevCode = lcNumber) or (PrevCode = lcString)
           or (PrevCode = lxAS) or (PrevSt = ')'))
          then
            Alias := St
          else
            Expr := Expr + St;
        end;
        if (Code = lcEnd) or (Code = lxFROM) and (BracketCount = 0) then
          break;
      until False;
    end;
  finally
    Parser.Free;
  end;
end;

type
  TLocalTableInfo = record
    TableName: string;
    Synonym: string;
    DBLink: string;
    Schema: string;

    Flag: byte;
  end;

  TLocalTablesInfo = array of TLocalTableInfo;

procedure TCustomOraDataSetService.GetFieldsInfo;
var
  Columns: TList;
  UserName: string;
  Query: TCustomDADataSet;
  Tables: TLocalTablesInfo;

  function AddDBLink(DBLink: string): string;
  begin
    if DBLink <> '' then
      Result := '@' + DBLink;
  end;

  function GetDefExpr(Value: string; DataType: string): string;
  var
    P: integer;
    DeqValue: string;
  begin
    if DefaultExpressionOldBehavior then begin
      Result := TrimRight(Value);
      DeqValue := AnsiDequotedStr(Result, '''');
      if (Result <> DeqValue) and (AnsiQuotedStr(DeqValue, '''') = Result) then // '1' + '2' should not be dequoted
        Result := DeqValue;
      if (DataType = 'NUMBER') and (DecimalSeparator{$IFDEF CLR}[1]{$ENDIF} <> '.') then begin
        P := Pos('.', Result);
        if P > 0 then
          Result[P] := DecimalSeparator{$IFDEF CLR}[1]{$ENDIF};
      end;
    end
    else
      Result := Value;
  end;

  function GetOwner: string;
  begin
    Result := TOCIConnection(TDBAccessUtils.GetIConnection(UsedConnection)).GetCachedSchema;
  end;

  procedure GetFieldsInfoServer(var NeedDescribeSynonyms: boolean);
  var
    SQL, Filter: string;
    CurTableName, FieldTableName, CurOwner, FieldOwner, DBLink: string;
    j, p: integer;
    ColumnInfo, NewColumnInfo: TColumnInfo;
    Located, MoreDBLinks: boolean;
  begin
    NeedDescribeSynonyms := False;
    for j := 0 to High(Tables) do
      Tables[j].Flag := Tables[j].Flag and not 2; // 2 - info is queried
    repeat
      Filter := '';
      MoreDBLinks := False;
      for j := 0 to High(Tables) do
        if (Tables[j].Flag and 1 <> 0) and (Tables[j].Flag and 2 = 0) then begin
          if Filter = '' then
            DBLink := Tables[j].DBLink
          else begin
            if Tables[j].DBLink <> DBLink then begin
              MoreDBLinks := True;
              continue;
            end;
            Tables[j].Flag := Tables[j].Flag or 2;
            Filter := Filter + ' OR';
          end;
          Filter := Filter + ' (table_name = ''' + Tables[j].TableName + '''' +
            ' and owner = ''' + Tables[j].Schema + ''')';