• Delphi 从tnsnames.ora文件中获取Oracle服务名


    1 //从注册表中读出tnsnames.ora路径并调用解析函数
     2 procedure TfmLogin.GetServer;
     3 var
     4   reg : Tregistry;
     5   regValue : TStrings;
     6   values : string;
     7 begin
     8   reg := TRegistry.Create;
     9   regValue := TStrings.Create;
    10   try
    11     reg.RootKey := HKEY_LOCAL_MACHINE;
    12     reg.OpenKeyReadOnly('SOFTWAREORACLESYSMANOracleDBConsoleorcl');
    13     //reg.GetValueNames(regValue);
    14     values := reg.ReadString('ORACLE_HOME');
    15     values := values + 'NETWORKADMIN	nsnames.ora';
    16     regValue := ParseTnsnames(values);
    17     //ShowMessage(regValue.Text);
    18     cbbDataSoure.Items := regValue;
    19     cbbDataSoure.Items.Delete(cbbDataSoure.Items.Count-1);
    20   finally
    21     reg.CloseKey;
    22     reg.Free;
    23     regValue.Free;
    24   end
    25 
    26 end;--------------------------------------------------------------------------------------------------------------------获取oracle主路径的改进版本,使用递归查找ORACLE_HOME键
    
     1 procedure TForm1.btn1Click(Sender: TObject);
     2 var
     3   reg : Tregistry;
     4   regValue : TStrings;
     5   values : string;
     6   regStr : string;
     7   i : Integer;
     8 begin
     9   regStr := 'SOFTWAREORACLE';
    10   reg := TRegistry.Create;
    11   regValue := TStrings.Create;
    12 
    13   reg.RootKey := HKEY_LOCAL_MACHINE;
    14  //reg.OpenKeyReadOnly('SOFTWAREORACLESYSMANOracleDBConsoleorcl');
    15 
    16   values := GetPath(reg,regStr);
    17  // ShowMessage(values);
    18 
    19   //values := reg.ReadString('ORACLE_HOME');
    20   values := values + 'NETWORKADMIN	nsnames.ora';
    21   regValue := ParseTnsnames(values);
    22   ShowMessage(regValue.Text);
    23   cbb1.Items := regValue;
    24   cbb1.Items.Delete(cbb1.Items.Count-1);
    25 
    26   reg.CloseKey;
    27   reg.Free;
    28   regValue.Free;
    29 end;
    30 
    31 //从注册表中递归获取oracle主路径
    32 function TForm1.GetPath(reg : Tregistry ; regPath : string): string;
    33 var
    34   haskey : TStringList;
    35   i : Integer;
    36 begin
    37   haskey := TStringList.Create;
    38   reg.CloseKey;
    39   reg.OpenKeyReadOnly(regPath);  //注意要关闭之前的操作才能打开其他主键
    40   Result := reg.ReadString('ORACLE_HOME');
    41   if reg.HasSubKeys and (Result = '') then  //是否有子键
    42   begin
    43     reg.GetKeyNames(haskey);
    44     for i := 0 to haskey.Count-1 do
    45     begin
    46       Result := GetPath(reg,regPath + '' + haskey[i]);
    47       if Result <> '' then
    48          Break;
    49     end;
    50   end;
    51   haskey.Free;
    52   reg.CloseKey;
    53 end;
    --------------------------------------------------------------------------------------------------------------------
    获取oracle主路径的改进版本,使用递归查找ORACLE_HOME键
    procedure TForm1.btn1Click(Sender: TObject);
    var
      reg : Tregistry;
      regValue : TStrings;
      values : string;
      regStr : string;
      i : Integer;
    begin
      regStr := 'SOFTWAREORACLE';
      reg := TRegistry.Create;
      regValue := TStrings.Create;
    
      reg.RootKey := HKEY_LOCAL_MACHINE;
     //reg.OpenKeyReadOnly('SOFTWAREORACLESYSMANOracleDBConsoleorcl');
    
      values := GetPath(reg,regStr);
     // ShowMessage(values);
    
      //values := reg.ReadString('ORACLE_HOME');
      values := values + 'NETWORKADMIN	nsnames.ora';
      regValue := ParseTnsnames(values);
      ShowMessage(regValue.Text);
      cbb1.Items := regValue;
      cbb1.Items.Delete(cbb1.Items.Count-1);
    
      reg.CloseKey;
      reg.Free;
      regValue.Free;
    end;
    
    //从注册表中递归获取oracle主路径
    function TForm1.GetPath(reg : Tregistry ; regPath : string): string;
    var
      haskey : TStringList;
      i : Integer;
    begin
      haskey := TStringList.Create;
      reg.CloseKey;
      reg.OpenKeyReadOnly(regPath);  //注意要关闭之前的操作才能打开其他主键
      Result := reg.ReadString('ORACLE_HOME');
      if reg.HasSubKeys and (Result = '') then  //是否有子键
      begin
        reg.GetKeyNames(haskey);
        for i := 0 to haskey.Count-1 do
        begin
          Result := GetPath(reg,regPath + '' + haskey[i]);
          if Result <> '' then
             Break;
        end;
      end;
      haskey.Free;
      reg.CloseKey;
    end;
    //获取tnsnames.ora文件的服务名
    function TfmLogin.ParseTnsnames(sFileName: String): TStrings;
    var
      output: string;
      fileLine: string;
      iGhCnt:integer;// 刮号数量,(加一, )减一;
      i, j: integer;
      sListSrc: TStringList;
      sListDec:TStringList;
      iLength: integer;
      lineChar: Char;
    begin
       sListSrc:=TStringList.Create;
       sListDec:=TStringList.Create;
       try
       sListSrc.LoadFromFile(sFileName);
       except
         FreeAndNil(sListSrc);
         result:= sListDec;
         exit;
       end;
      iGhCnt:=0;
      for I := 0 to sListSrc.Count - 1 do
      begin
        fileLine := sListSrc[i];
        fileLine := trim(fileLine);
        iLength := length(fileLine);
        if (Length(fileLine) = 0) or (fileLine[1] = '#') then
          Continue;
    
        for j := 1 to iLength do
        begin
          lineChar := fileLine[j];
          if lineChar = '(' then
             inc(iGhCnt)
          else if (lineChar = ')') then
            dec(iGhCnt)
          else if (iGhCnt = 0) then
            output := output + lineChar;
        end;
    
      end;
    
        output:=StringReplace(output,'=',',',[rfReplaceAll]) ;
    
        if output='' then
        begin
         FreeAndNil(sListSrc);
         result:= sListDec;
         exit;
        end;
    
       FreeAndNil(sListSrc);
       sListDec.CommaText:=output;
       result:=sListDec;
    end;

    好的代码像粥一样,都是用时间熬出来的
  • 相关阅读:
    javascript之instanceof原理
    x86之描述符表寄存器
    Mac之DTerm
    C的一些特性
    Mac i386 Operands and Addressing Modes
    shell之条件测试
    linux之dup&dup2
    javascript之this
    x86之段描述符
    进制转换
  • 原文地址:https://www.cnblogs.com/jijm123/p/13570848.html
Copyright © 2020-2023  润新知