resolved #8555

* fixed KeyExists on windows
+ added simple test for KeyExists

git-svn-id: trunk@7063 -

.gitattributes

@@ -4256,6 +4256,10 @@ packages/fcl-registry/src/registry.pp svneol=native#text/plain
 packages/fcl-registry/src/winreg.inc svneol=native#text/plain
 packages/fcl-registry/src/xmlreg.pp svneol=native#text/plain
 packages/fcl-registry/src/xregreg.inc svneol=native#text/plain
+packages/fcl-registry/tests/Makefile svneol=native#text/plain
+packages/fcl-registry/tests/Makefile.fpc -text
+packages/fcl-registry/tests/regtestframework.pp -text
+packages/fcl-registry/tests/testbasics.pp svneol=native#text/plain
 packages/fcl-web/Makefile svneol=native#text/plain
 packages/fcl-web/Makefile.fpc svneol=native#text/plain
 packages/fcl-web/src/README svneol=native#text/plain

packages/fcl-registry/src/winreg.inc

@@ -24,7 +24,7 @@ end;
 Function RelativeKey(Const S : String) : Boolean;
 
 begin
-  Result:=(S[1]<>'\')
+  Result:=(S='') or (S[1]<>'\')
 end;
 
 
@@ -107,11 +107,21 @@ begin
     end
 end;
 
+
 function TRegistry.GetKey(const Key: String): HKEY;
+var
+  S : string;
+  Rel : Boolean;
 begin
-  Result := FCurrentKey;
+  Result:=0;
+  S:=Key;
+  Rel:=RelativeKey(S);
+  if not(Rel) then 
+    Delete(S,1,1);
+  RegOpenKeyEx(GetBaseKey(Rel),PChar(S),0,FAccess,Result);
 end;
 
+
 function TRegistry.GetKeyInfo(var Value: TRegKeyInfo): Boolean;
 var
   winFileTime: Windows.FILETIME;
@@ -129,20 +139,34 @@ begin
   end;
 end;
 
+
 function TRegistry.KeyExists(const Key: string): Boolean;
-
-Var
-  Value : TRegKeyInfo;
-
+var
+  KeyHandle : HKEY;
+  OldAccess : LONG;
 begin
-  Result :=GetKeyInfo(Value);
+  Result:=false;
+  OldAccess:=FAccess;
+  try
+    FAccess:=KEY_QUERY_VALUE or KEY_ENUMERATE_SUB_KEYS or STANDARD_RIGHTS_READ;
+    KeyHandle:=GetKey(Key);
+    if KeyHandle<>0 then
+      begin
+        RegCloseKey(KeyHandle);
+        Result:=true;
+      end;
+  finally
+    FAccess:=OldAccess;
+  end;
 end;
 
+
 function TRegistry.LoadKey(const Key, FileName: string): Boolean;
 begin
   Result := False;
 end;
 
+
 function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
 
 Var

packages/fcl-registry/tests/Makefile.fpc

@@ -0,0 +1,19 @@
+#
+#   Makefile.fpc for DB TestFramework
+#
+
+[package]
+main=fcl
+
+[target]
+examples=regtestframework
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../../..
+
+
+[rules]
+.NOTPARALLEL:

packages/fcl-registry/tests/regtestframework.pp

@@ -0,0 +1,53 @@
+program regtestframework;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+{ $DEFINE STOREDB}
+
+{$APPTYPE CONSOLE}
+
+uses
+  SysUtils,
+  fpcunit,  testreport, testregistry,
+{$IFDEF STOREDB}
+  DBResultsWriter,
+{$ENDIF}
+// Units wich contains the tests
+  testbasics;
+
+var
+  FXMLResultsWriter: TXMLResultsWriter;
+{$IFDEF STOREDB}
+  FDBResultsWriter: TDBResultsWriter;
+{$ENDIF}
+  testResult: TTestResult;
+begin
+  testResult := TTestResult.Create;
+  FXMLResultsWriter := TXMLResultsWriter.Create;
+{$IFDEF STOREDB}
+  FDBResultsWriter := TDBResultsWriter.Create;
+{$ENDIF}
+  try
+    testResult.AddListener(FXMLResultsWriter);
+{$IFDEF STOREDB}
+    testResult.AddListener(FDBResultsWriter);
+{$ENDIF}
+    FXMLResultsWriter.WriteHeader;
+{$IFDEF STOREDB}
+    FDBResultsWriter.OpenConnection(dbconnectorname+';'+dbconnectorparams);
+{$ENDIF}
+    GetTestRegistry.Run(testResult);
+    FXMLResultsWriter.WriteResult(testResult);
+{$IFDEF STOREDB}
+    FDBResultsWriter.CloseConnection;
+{$ENDIF}
+  finally
+    testResult.Free;
+    FXMLResultsWriter.Free;
+{$IFDEF STOREDB}
+    FDBResultsWriter.Free;
+{$ENDIF}
+  end;
+end.

packages/fcl-registry/tests/testbasics.pp

@@ -0,0 +1,51 @@
+unit TestBasics;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  fpcunit, testutils, testregistry, testdecorator,
+  Classes, SysUtils;
+
+type
+
+  { TTestBasics }
+
+  TTestBasics = class(TTestCase)
+  private
+  protected
+  published
+    procedure TestSimpleWinRegistry;
+  end;
+
+implementation
+
+uses
+  registry;
+
+{ TTestBasics }
+
+procedure TTestBasics.TestSimpleWinRegistry;
+var
+  Registry : TRegistry;
+begin
+  Registry := TRegistry.Create(KEY_READ);
+  Registry.RootKey:=HKEY_LOCAL_MACHINE;
+
+  // use a hopefully non existing key
+  AssertFalse(Registry.KeyExists('FPC1234'));
+
+  AssertTrue(Registry.KeyExists('SOFTWARE'));
+
+  // Registry.OpenKey('FPC', False);
+  // Result:=Registry.ReadString('VALUE1');
+
+  Registry.Free;
+end;
+
+initialization
+  RegisterTest(TTestBasics);
+end.