/EndTask/2008.04.16 ?????/Oracle Data Access Components(ODAC) v6/Source/OdacGui.inc

type



{ TConnectDialog }



  TConnectDialog = class(TCustomConnectDialog)

  private

    FReadAliases: boolean;



    function GetSession: TOraSession;



  protected

    function GetKeyPath: string; override;

    function GetServerStoreName: string; override;



    function DefDialogClass: TClass; override;

  public

    constructor Create(Owner: TComponent); override;



    procedure GetServerList(List: TStrings); override;



    property Session: TOraSession read GetSession;



  published

    property ReadAliases: boolean read FReadAliases write FReadAliases default{$IFDEF MSWINDOWS} False {$ENDIF}{$IFDEF LINUX} True {$ENDIF};



    property Retries;

    property SavePassword;

    property StoreLogInfo;



    property DialogClass;



    property Caption;

    property UsernameLabel;

    property PasswordLabel;

    property ServerLabel;

    property ConnectButton;

    property CancelButton;



    property LabelSet;

  end;



function DefConnectDialogClass: TClass;

procedure GetOraServerList(List: TStrings; HomePath: string;

  ReadAliases, Direct: boolean; RaiseErrors: boolean = True);



implementation



{$IFDEF MSWINDOWS}

uses

  Forms, Messages;

{$ENDIF}



function DefConnectDialogClass: TClass;

begin

  Result := TConnectDialog;

end;



type

  _TParser = class (TParser)

  protected

    function IsInlineComment(Pos: integer): boolean; override;

  end;



const

  KeyPath = '\SOFTWARE\CoreLab\ODAC\';



procedure GetOraServerList(List: TStrings; HomePath: string;

  ReadAliases, Direct: boolean; RaiseErrors: boolean = True);

const

  sCannotFind = 'Cannot find ';

  sError = 'sError';

  sTnsAdmin = 'TNS_ADMIN';

{$IFDEF MSWINDOWS}

  sOraHomeKey = 'SOFTWARE\ORACLE\';

  sNetwork = '\network\admin\';

  sNet80 = '\net80\admin\';

  sTnsNames = 'tnsnames.ora';

{$ENDIF}

{$IFDEF LINUX}

  sTnsNames = '/network/admin/tnsnames.ora';

{$ENDIF}

var

{$IFDEF MSWINDOWS}

  Registry: TRegistry;

  RegIniFile: TRegIniFile;

  ServerLabel: string;

{$ENDIF}

  i, j: integer;

  IFile, F: TStrings;

  Parser: _TParser;

  Code: integer;

  Text,St,OldSt,Alias: string;

  Bracket: integer;

  CurrentDir, FileName: string;



  function AddPath(Path, FileName: string): string;

  begin

    if (Path <> '') and (Path[Length(Path)] <> '\') then

      Result := Path + '\' + FileName

    else

      Result := Path + FileName;

  end;



begin

  if ReadAliases and not Direct then begin

    try

      if not OCIInited then

        OCIInit;

    except

      if RaiseErrors then

        raise;

    end;



    if HomePath = '' then

      HomePath := OracleHomePath;



    if HomePath <> '' then

      try

        F := TStringList.Create;

        Parser := _TParser.Create('');

        Parser.OmitBlank := True;

        Parser.OmitComment := True;

        try

        {$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);

          end

          else

        {$ENDIF}

            FileName := '';



          if FileExists(FileName) then

            F.LoadFromFile(FileName)

          else begin

          /// look for TNS_ADMIN variable in registry

            RegIniFile := TRegIniFile.Create('');

            try

              RegIniFile.RootKey := HKEY_LOCAL_MACHINE;

              if OracleHomeName = '' then

                FileName := AddPath(RegIniFile.ReadString(sOraHomeKey +

                  OracleHomeKeys[DefaultOracleHome], sTnsAdmin, ''), sTnsNames)

              else

                for i := 0 to OracleHomeCount - 1 do

                  if AnsiCompareText(OracleHomeNames[i] , OracleHomeName) = 0 then begin

                    FileName := AddPath(RegIniFile.ReadString(sOraHomeKey +

                      OracleHomeKeys[i], sTnsAdmin, ''), sTnsNames);

                    break;

                  end;

            finally

              RegIniFile.Free;

            end;



            if FileExists(FileName) then

              F.LoadFromFile(FileName)

            else begin

            /// look for tnsnames.ora in Oracle Home

              FileName := HomePath + sNetwork + sTnsNames;

              if FileExists(FileName) then

                F.LoadFromFile(FileName)

              else begin

                FileName := HomePath + sNet80 + sTnsNames;

                if FileExists(FileName) then

                  F.LoadFromFile(FileName)

              end;

            end;

          end;

        {$ENDIF}

        {$IFDEF LINUX}

          FileName := HomePath + sTnsNames;

          if FileExists(FileName) then

            F.LoadFromFile(FileName);

        {$ENDIF}



          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;

      except

        // do not raise parser errors

      end;

  end

{$IFDEF MSWINDOWS}

  else begin

  {$IFDEF NET}

    if Direct then

      ServerLabel := 'NServer'

    else

  {$ENDIF}

      ServerLabel := 'Server';



    Registry := TRegistry.Create;

    try

      if Registry.OpenKey(KeyPath + 'Connect', False) then begin

        List.Clear;

        i := 1;

        while Registry.ValueExists(ServerLabel + IntToStr(i)) do begin

          List.Add(Registry.ReadString(ServerLabel + IntToStr(i)));

          Inc(i);

        end;

        Registry.CloseKey;

      end;

    finally

      Registry.Free;

    end;

  end;

{$ENDIF}

end;



{ TConnectDialog }



constructor TConnectDialog.Create(Owner: TComponent);

begin

  inherited Create(Owner);



{$IFDEF LINUX}

  ReadAliases := True;

{$ENDIF}

end;



function TConnectDialog.DefDialogClass: TClass;

begin

  Result := TConnectForm;

end;



function TConnectDialog.GetKeyPath: string;

begin

  Result := KeyPath;

end;



function TConnectDialog.GetServerStoreName: string;

begin

{$IFDEF NET}

  if Session.Options.Direct then

    Result := 'NServer'

  else

{$ENDIF}

    Result := 'Server';

end;



procedure TConnectDialog.GetServerList(List: TStrings);

var

  Direct: boolean;

begin

  Direct := False;

  if Session <> nil then

    Direct := Session.Options.Direct;



  GetOraServerList(List, OracleHomePath, ReadAliases, Direct);

end;



function _TParser.IsInlineComment(Pos: integer): boolean;

begin

  Result := (TextLength >= Pos + 1) and (Text[Pos] = '#');

end;



function TConnectDialog.GetSession: TOraSession;

begin

  Result := TOraSession(Connection);

end;



{$IFDEF MSWINDOWS}

var

  CheckIniChange: TWindowHook;



{$IFDEF CLR}

function DoCheckIniChange(var Message: TMessage): Boolean;

var

  AApplication: TApplication;

begin

  AApplication := Application;

{$ELSE}

function DoCheckIniChange(AApplication: TApplication; var Message: TMessage): Boolean;

begin

{$ENDIF}

  Result := False;

  if (Message.Msg = WM_WININICHANGE) then

  begin

    if AApplication.UpdateFormatSettings then

    begin

      SetThreadLocale(LOCALE_USER_DEFAULT);

      OraClasses.GetTimeFormat;

    end;

  end;

end;

{$ENDIF}



initialization

  DefConnectDialogClassProc := DefConnectDialogClass;

{$IFDEF MSWINDOWS}

{$IFDEF CLR}

  CheckIniChange := DoCheckIniChange;

{$ELSE}

  TMethod(CheckIniChange).Code := @DoCheckIniChange;

  TMethod(CheckIniChange).Data := Application;

{$ENDIF}

  Application.HookMainWindow(CheckIniChange);

finalization

  Application.UnhookMainWindow(CheckIniChange);

{$ENDIF}

end.