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('SOFTWARE\ORACLE\SYSMAN\OracleDBConsoleorcl');
13     //reg.GetValueNames(regValue);
14     values := reg.ReadString('ORACLE_HOME');
15     values := values + '\NETWORK\ADMIN\tnsnames.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 := 'SOFTWARE\ORACLE';
10   reg := TRegistry.Create;
11   regValue := TStrings.Create;
12 
13   reg.RootKey := HKEY_LOCAL_MACHINE;
14  //reg.OpenKeyReadOnly('SOFTWARE\ORACLE\SYSMAN\OracleDBConsoleorcl');
15 
16   values := GetPath(reg,regStr);
17  // ShowMessage(values);
18 
19   //values := reg.ReadString('ORACLE_HOME');
20   values := values + '\NETWORK\ADMIN\tnsnames.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;

 1 //获取tnsnames.ora文件的服务名
 2 function TfmLogin.ParseTnsnames(sFileName: String): TStrings;
 3 var
 4   output: string;
 5   fileLine: string;
 6   iGhCnt:integer;// 刮号数量，(加一， )减一;
 7   i, j: integer;
 8   sListSrc: TStringList;
 9   sListDec:TStringList;
10   iLength: integer;
11   lineChar: Char;
12 begin
13    sListSrc:=TStringList.Create;
14    sListDec:=TStringList.Create;
15    try
16    sListSrc.LoadFromFile(sFileName);
17    except
18      FreeAndNil(sListSrc);
19      result:= sListDec;
20      exit;
21    end;
22   iGhCnt:=0;
23   for I := 0 to sListSrc.Count - 1 do
24   begin
25     fileLine := sListSrc[i];
26     fileLine := trim(fileLine);
27     iLength := length(fileLine);
28     if (Length(fileLine) = 0) or (fileLine[1] = '#') then
29       Continue;
30 
31     for j := 1 to iLength do
32     begin
33       lineChar := fileLine[j];
34       if lineChar = '(' then
35          inc(iGhCnt)
36       else if (lineChar = ')') then
37         dec(iGhCnt)
38       else if (iGhCnt = 0) then
39         output := output + lineChar;
40     end;
41 
42   end;
43 
44     output:=StringReplace(output,'=',',',[rfReplaceAll]) ;
45 
46     if output='' then
47     begin
48      FreeAndNil(sListSrc);
49      result:= sListDec;
50      exit;
51     end;
52 
53    FreeAndNil(sListSrc);
54    sListDec.CommaText:=output;
55    result:=sListDec;
56 end;