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;
参考：http://www.itpub.net/thread-1145748-1-1.html
