oraservicesuni.pas

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

            ReadFieldsFromServer := True;
       end;
     end;

(*     if not (ExtendedFieldsInfo or FDataSet.Options.DefaultValues or FDataSet.Options.FieldsOrigin) and
       ReadFieldsFromServer
     then
       Exit; //TODO: Imposible to tune*)

     ReadFieldsFromServer := ReadFieldsFromServer and
       (FExtendedFieldsInfo or FDataSet.Options.DefaultValues or FDataSet.Options.FieldsOrigin);


     if ReadFieldsFromServer or FDataSet.Options.DefaultValues then
       GetTablesFields;

     for i := 0 to FDataSet.FieldCount - 1 do
       if FDataSet.Fields[i].FieldKind = fkData then begin
         FieldDesc := TCRFieldDesc(FDataSet.GetFieldDesc(FDataSet.Fields[i]));
         FieldName := FieldDesc.ActualName;
         for j := 0 to Columns.Count - 1 do begin
           ColumnInfo := TColumnInfo(Columns[j]);
           if (FieldName = ColumnInfo.Alias) and (not ColumnInfo.Used) and
             (not ReadFieldsFromServer or (ColumnInfo.TableIndex <> -1))
           then begin
             if ColumnInfo.Name <> '' then begin
               ColumnInfo.Used := True;
               if ColumnInfo.TableIndex <> - 1 then
                 FieldDesc.TableInfo := TablesInfo[ColumnInfo.TableIndex]
               else
                 // When ExtendedFieldsInfo = False we suggest that field w/o Table
                 // belong to first table in TablesInfo
                 if (ColumnInfo.Table = '') and not ReadFieldsFromServer then
                   FieldDesc.TableInfo := TablesInfo[0];
               Origin := ColumnInfo.Name;
               if ColumnInfo.Alias <> '' then
                 FieldDesc.ActualName := ColumnInfo.Name;
               if ColumnInfo.Expr <> '' then
                 FDataSet.Fields[i].DefaultExpression := ColumnInfo.Expr;
             end;
             break;
           end
           else
             // If we don't find corresponding ColumnInfo,
             // we suggest that field belong to the same table that '*' belong
             if j = Columns.Count - 1 then begin
               if not ReadFieldsFromServer and (DefaultTable <> -1) then
                 FieldDesc.TableInfo := TablesInfo[DefaultTable];
               Origin := FieldName;
             end;
         end;

         if FDataSet.Options.FieldsOrigin then begin
           if FieldDesc.TableInfo <> nil then
             Origin := FieldDesc.TableInfo.TableName + '.' + Origin;
            FDataSet.Fields[i].Origin := Origin;
         end;
       end;
   finally
     for i := 0 to Columns.Count - 1 do
       TObject(Columns[i]).Free;
     Columns.Free;
   end;
  finally
    for i := 0 to ColumnCount - 1 do
      ColumnsInfo[i].Free;
  end;
  FFieldsInfoRequested := True;
end;

function TCustomOraDataSetService.GetRecCount: integer;
var
  St: string;
  UpdateQuery: TCustomDADataSet;
  MonitorClass: TDASQLMonitorClass;
  MessageID: cardinal;
  Parser: TOraParser;
begin
  Result := 0;
  St := FDataSet.FinalSQL;
  St := _SetOrderBy(St, '', TOraParser);
  Parser := TOraParser.Create(PChar(St));
  try
    if Parser.ToLexem(lxFOR) <> lcEnd then begin
      St := copy(St, 1, Parser.CurrPos - 3);
    end;
  finally
    Parser.Free;
  end;
  St := 'SELECT Count(*) FROM (' + LineSeparator + St + ')';

  FUpdater.CheckUpdateQuery(stCustom);
  UpdateQuery := TCustomDADataSet(FUpdater.UpdateQuery);
  UpdateQuery.SQL.Text := St;
  UpdateQuery.Params.Assign(FDataSet.Params);

  UpdateQuery.Prepare;
  if TOCICommand(TDBAccessUtils.GetICommand(UpdateQuery)).GetSQLType = SQL_SELECT then begin
    MonitorClass := TDASQLMonitorClass(TDBAccessUtils.SQLMonitorClass(UsedConnection));
    if MonitorClass.HasMonitor or FDataSet.Debug then
      MonitorClass.SQLExecute(FDataSet, St, UpdateQuery.Params, 'Get RecordCount', MessageID, True);

    UpdateQuery.Open;
    if not UpdateQuery.EOF then
      Result := UpdateQuery.Fields[0].AsInteger;

    if MonitorClass.HasMonitor or FDataSet.Debug then
      MonitorClass.SQLExecute(FDataSet, St, UpdateQuery.Params, 'Get RecordCount', MessageID, False);
  end;
end;

function TCustomOraDataSetService.GetIRecordSet: TCRRecordSet;
begin
  Result := inherited GetIRecordSet;
end;

function TCustomOraDataSetService.UsedConnection: TCustomDAConnection;
begin
  Result := inherited UsedConnection;
end;

function TCustomOraDataSetService.IsFullRefresh: boolean;
begin
  Result := inherited IsFullRefresh;
end;

function TCustomOraDataSetService.IsDMLRefresh: boolean;
begin
  Result := inherited IsDMLRefresh;
end;

function TCustomOraDataSetService.IsInCacheProcessing: boolean;
begin
  Result := inherited IsInCacheProcessing;
end;

function TCustomOraDataSetService.GetKeyFields: string;
begin
  Result := inherited GetKeyFields;
end;

function TCustomOraDataSetService.IsAutoCommit: boolean;
begin
  Result := inherited IsAutoCommit;
end;

function TCustomOraDataSetService.CompatibilityMode: boolean;
begin
  Result := False;
end;

function TCustomOraDataSetService.GetFieldClass(FieldType: TFieldType): TFieldClass;
{$IFDEF VER10P}
var
  Value: variant;
{$ENDIF}
begin
{$IFDEF VER10P}
  if FieldType = ftOraClob then begin
    TDBAccessUtils.GetIConnection(UsedConnection).GetProp(prUseUnicode, Value);
    if Boolean(Value) then
      Result := TWideMemoField
    else
      Result := TMemoField;
  end
  else
{$ENDIF}
    Result := inherited GetFieldClass(FieldType);
end;

{ TOraServerEnumerator }

type
  TTNSParser = class (TParser)
  protected
    function IsInlineComment(Pos: integer): boolean; override;
  end;

function TTNSParser.IsInlineComment(Pos: integer): boolean;
begin
  Result := (TextLength >= Pos + 1) and (Text[Pos] = '#');
end;

procedure TOraServerEnumerator.GetServerList(List: TStrings);
const
  sCannotFind = 'Cannot find ';
  sTnsAdmin = 'TNS_ADMIN';
  sTnsNames = 'tnsnames.ora';
{$IFDEF MSWINDOWS}
  sOraHomeKey = 'SOFTWARE\ORACLE\';
  sNetwork = '\network\admin\';
  sNet80 = '\net80\admin\';
{$ENDIF}
{$IFDEF LINUX}
  sNetwork = '/network/admin/';
{$ENDIF}
var
{$IFDEF MSWINDOWS}
  RegIniFile: TRegIniFile;
{$ENDIF}
  i, j: integer;
  IFile, F: TStrings;
  Parser: TTNSParser;
  Code: integer;
  Text,St,OldSt,Alias: string;
  Bracket: integer;
  HomePath, CurrentDir, FileName: string;
  TNSFound: boolean;

  function AddPath(Path, FileName: string): string;
  begin
    if (Path <> '') and (Path[Length(Path)] <> '\') then
      Result := Path + '\' + FileName
    else
      Result := Path + FileName;
  end;

begin
  inherited;

  if FDirect then
    exit;

  TNSFound := False;

  if FTNSPath <> '' then begin
    FileName := AddPath(FTNSPath, sTnsNames);
    if FileExists(FileName) then
      TNSFound := True;
  end
  else begin
  {$IFDEF MSWINDOWS}
    /// check if TNS_ADMIN environment variable is set
  {$IFNDEF CLR}
    i := GetEnvironmentVariable(sTnsAdmin, nil, 0);
    if i > 0 then begin
      SetLength(FileName, i - 1);
      GetEnvironmentVariable(sTnsAdmin, PChar(FileName), Length(FileName) + 1);
      FileName := AddPath(FileName, sTnsNames);
      if FileExists(FileName) then
        TNSFound := True;
    end;
  {$ENDIF}

    if not TNSFound then begin
      /// look for TNS_ADMIN variable in registry
      if not LoadedOCI then
        DetectOCI;

      RegIniFile := TRegIniFile.Create('');
      try
        RegIniFile.RootKey := HKEY_LOCAL_MACHINE;
        if (FHomeName = '') and (OracleHomeCount > 0) then
          FileName := AddPath(RegIniFile.ReadString(sOraHomeKey +
            OracleHomeKeys[DefaultOracleHome], sTnsAdmin, ''), sTnsNames)
        else
          for i := 0 to OracleHomeCount - 1 do
            if AnsiCompareText(OracleHomeNames[i] , FHomeName) = 0 then begin
              FileName := AddPath(RegIniFile.ReadString(sOraHomeKey +
                OracleHomeKeys[i], sTnsAdmin, ''), sTnsNames);
              break;
            end;
      finally
        RegIniFile.Free;
      end;

      if FileExists(FileName) then
        TNSFound := True;
    end;
  {$ENDIF}

    if not TNSFound then begin
      /// look for tnsnames.ora in Oracle Home
      if FHomeName = '' then
        HomePath := OracleHomePath
      else
        for i := 0 to OracleHomeCount - 1 do
          if AnsiCompareText(OracleHomeNames[i] , FHomeName) = 0 then begin
            HomePath := OracleHomePaths[i];
            break;
          end;

      if HomePath <> '' then begin
        FileName := HomePath + sNetwork + sTnsNames;
        if FileExists(FileName) then
          TNSFound := True
        else begin
        {$IFNDEF LINUX}
          FileName := HomePath + sNet80 + sTnsNames;
          if FileExists(FileName) then
            TNSFound := True
        {$ENDIF}
        end;
      end;
    end;
  end;

  if not TNSFound then
    exit;

  F := TStringList.Create;
  Parser := TTNSParser.Create('');
  try
    Parser.OmitBlank := True;
    Parser.OmitComment := True;
    F.LoadFromFile(FileName);

    IFile := TStringList.Create;
    i := 0;
    CurrentDir := GetCurrentDir;
    SetCurrentDir(ExtractFileDir(FileName));
    try
      while i < F.Count do begin
        if Pos('IFILE', AnsiUpperCase(F[i])) > 0 then begin
          FileName := Trim(Copy(F[i], Pos('=',F[i]) + 1, MaxInt));
          if FileExists(FileName) then begin
            IFile.LoadFromFile(FileName);
            F.Delete(i);
            for j := IFile.Count - 1 downto 0 do
               F.Insert(i, IFile[j]);
            Continue;
          end;
        end;
        Inc(i);
      end;
    finally
      SetCurrentDir(CurrentDir);
      IFile.Free;
    end;

    Text := F.Text;
    Parser.SetText(PChar(Text));
    Code := 0;
    St := '';
    Alias := '';
    Bracket := 0;
    List.Clear;
    repeat
      if (Bracket = 0) and ((Code = lcIdent) or (Code = lcNumber) or (St = '-')) then
        if OldSt = '.' then begin
          if (AnsiUpperCase(St) <> 'WORLD') or (OCIVersion > 8100) then
            Alias := Alias + '.' + St
        end
        else
          Alias := Alias + St;

      OldSt := St;

      Code := Parser.GetNext(St);
      if St = '(' then
        Inc(Bracket)
      else
        if St = ')' then
          Dec(Bracket)
        else
          if (St = '=') and (Bracket = 0) then begin
            List.Add(Alias);
            Alias := '';
          end;
    until Code = lcEnd;
  finally
    Parser.Free;
    F.Free;
  end;
end;

function TOraServerEnumerator.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prHomeName:
      Value := FHomeName;
  else
    Result := inherited GetProp(Prop, Value);
  end;
end;

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

end.