Browse Source

* Added LastError and LastErrorMsg (bug ID 29681)

git-svn-id: trunk@33348 -
michael 9 years ago
parent
commit
9501faa00b

+ 14 - 8
packages/fcl-registry/src/registry.pp

@@ -42,8 +42,11 @@ type
     TRegistry
     TRegistry
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
+  { TRegistry }
+
   TRegistry = class(TObject)
   TRegistry = class(TObject)
   private
   private
+    FLastError: Longint;
     FStringSizeIncludesNull : Boolean;
     FStringSizeIncludesNull : Boolean;
     FSysData : Pointer;
     FSysData : Pointer;
     fAccess: LongWord;
     fAccess: LongWord;
@@ -51,6 +54,7 @@ type
     fRootKey: HKEY;
     fRootKey: HKEY;
     fLazyWrite: Boolean;
     fLazyWrite: Boolean;
     fCurrentPath: string;
     fCurrentPath: string;
+    function GetLastErrorMsg: string;
     procedure SetRootKey(Value: HKEY);
     procedure SetRootKey(Value: HKEY);
     Procedure SysRegCreate;
     Procedure SysRegCreate;
     Procedure SysRegFree;
     Procedure SysRegFree;
@@ -122,6 +126,8 @@ type
     property LazyWrite: Boolean read fLazyWrite write fLazyWrite;
     property LazyWrite: Boolean read fLazyWrite write fLazyWrite;
     property RootKey: HKEY read fRootKey write SetRootKey;
     property RootKey: HKEY read fRootKey write SetRootKey;
     Property StringSizeIncludesNull : Boolean read FStringSizeIncludesNull;
     Property StringSizeIncludesNull : Boolean read FStringSizeIncludesNull;
+    property LastError: Longint read FLastError; platform;
+    property LastErrorMsg: string read GetLastErrorMsg; platform;
   end;
   end;
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
@@ -225,7 +231,7 @@ implementation
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 
 
-Constructor TRegistry.Create;
+constructor TRegistry.Create;
 
 
 begin
 begin
   inherited Create;
   inherited Create;
@@ -236,21 +242,21 @@ begin
   SysRegCreate;
   SysRegCreate;
 end;
 end;
 
 
-Constructor TRegistry.Create(aaccess:longword);
+constructor TRegistry.Create(aaccess: longword);
 
 
 begin
 begin
   Create;
   Create;
   FAccess     := aaccess;
   FAccess     := aaccess;
 end;
 end;
 
 
-Destructor TRegistry.Destroy;
+destructor TRegistry.Destroy;
 begin
 begin
   CloseKey;
   CloseKey;
   SysRegFree;
   SysRegFree;
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
-function TRegistry.CreateKey(const Key: String): Boolean;
+function TRegistry.CreateKey(const Key: string): Boolean;
 
 
 begin
 begin
   Result:=SysCreateKey(Key);
   Result:=SysCreateKey(Key);
@@ -266,8 +272,8 @@ begin
     Result := RootKey;
     Result := RootKey;
 end;
 end;
 
 
-function TRegistry.GetData(const Name: String; Buffer: Pointer;
-          BufSize: Integer; var RegData: TRegDataType): Integer;
+function TRegistry.GetData(const Name: string; Buffer: Pointer;
+  BufSize: Integer; var RegData: TRegDataType): Integer;
 begin
 begin
   Result:=SysGetData(Name,Buffer,BufSize,RegData);
   Result:=SysGetData(Name,Buffer,BufSize,RegData);
   If (Result=-1) then
   If (Result=-1) then
@@ -283,7 +289,7 @@ begin
 end;
 end;
 
 
 
 
-function TRegistry.GetDataSize(const ValueName: String): Integer;
+function TRegistry.GetDataSize(const ValueName: string): Integer;
 
 
 Var
 Var
   Info: TRegDataInfo;
   Info: TRegDataInfo;
@@ -305,7 +311,7 @@ begin
   Result:=Info.RegData;
   Result:=Info.RegData;
 end;
 end;
 
 
-Function TRegistry.HasSubKeys: Boolean;
+function TRegistry.HasSubKeys: Boolean;
 
 
 Var
 Var
   Info : TRegKeyInfo;
   Info : TRegKeyInfo;

+ 41 - 18
packages/fcl-registry/src/winreg.inc

@@ -48,7 +48,7 @@ Var
 begin
 begin
   SecurityAttributes := Nil;
   SecurityAttributes := Nil;
   P:=PrepKey(Key);
   P:=PrepKey(Key);
-  Result:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),
+  FLastError:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),
                          P,
                          P,
                          0,
                          0,
                          '',
                          '',
@@ -56,7 +56,8 @@ begin
                          KEY_ALL_ACCESS,
                          KEY_ALL_ACCESS,
                          SecurityAttributes,
                          SecurityAttributes,
                          Handle,
                          Handle,
-                         @Disposition) = ERROR_SUCCESS;
+                         @Disposition);
+  Result:=FLastError=ERROR_SUCCESS;
   RegCloseKey(Handle);
   RegCloseKey(Handle);
 end;
 end;
 
 
@@ -66,12 +67,14 @@ Var
   P: PChar;
   P: PChar;
 begin
 begin
   P:=PRepKey(Key);
   P:=PRepKey(Key);
-  Result:=RegDeleteKeyA(GetBaseKey(RelativeKey(Key)),P)=ERROR_SUCCESS;
+  FLastError:=RegDeleteKeyA(GetBaseKey(RelativeKey(Key)),P);
+  Result:=FLastError=ERROR_SUCCESS;
 end;
 end;
 
 
 function TRegistry.DeleteValue(const Name: String): Boolean;
 function TRegistry.DeleteValue(const Name: String): Boolean;
 begin
 begin
-  Result := RegDeleteValueA(fCurrentKey, @Name[1]) = ERROR_SUCCESS;
+  FLastError:= RegDeleteValueA(fCurrentKey, @Name[1]);
+  Result:=FLastError=ERROR_SUCCESS;
 end;
 end;
 
 
 function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
 function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
@@ -82,8 +85,9 @@ Var
 
 
 begin
 begin
   P := PChar(Name);
   P := PChar(Name);
-  If RegQueryValueExA(fCurrentKey,P,Nil,
-                      @RD,Buffer,lpdword(@BufSize))<>ERROR_SUCCESS Then
+  FLastError:=RegQueryValueExA(fCurrentKey,P,Nil,
+                      @RD,Buffer,lpdword(@BufSize));
+  if (FLastError<>ERROR_SUCCESS) Then
     Result:=-1
     Result:=-1
   else
   else
     begin
     begin
@@ -109,7 +113,10 @@ Var
 begin
 begin
   P:=PChar(ValueName);
   P:=PChar(ValueName);
   With Value do
   With Value do
-    Result:=RegQueryValueExA(fCurrentKey,P,Nil,lpdword(@RegData),Nil,lpdword(@DataSize))=ERROR_SUCCESS;
+    begin
+    FLastError:=RegQueryValueExA(fCurrentKey,P,Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
+    Result:=FLastError=ERROR_SUCCESS;
+    end;
   If Not Result Then
   If Not Result Then
     begin
     begin
     Value.RegData := rdUnknown;
     Value.RegData := rdUnknown;
@@ -129,9 +136,9 @@ begin
   if not(Rel) then
   if not(Rel) then
     Delete(S,1,1);
     Delete(S,1,1);
 {$ifdef WinCE}
 {$ifdef WinCE}
-  RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result);
+  FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result);
 {$else WinCE}
 {$else WinCE}
-  RegOpenKeyEx(GetBaseKey(Rel),PChar(S),0,FAccess,Result);
+  FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PChar(S),0,FAccess,Result);
 {$endif WinCE}
 {$endif WinCE}
 end;
 end;
 
 
@@ -143,9 +150,12 @@ var
 begin
 begin
   FillChar(Value, SizeOf(Value), 0);
   FillChar(Value, SizeOf(Value), 0);
   With Value do
   With Value do
-    Result:=RegQueryInfoKeyA(CurrentKey,nil,nil,nil,lpdword(@NumSubKeys),
+    begin
+    FLastError:=RegQueryInfoKeyA(CurrentKey,nil,nil,nil,lpdword(@NumSubKeys),
               lpdword(@MaxSubKeyLen),nil,lpdword(@NumValues),lpdword(@MaxValueLen),
               lpdword(@MaxSubKeyLen),nil,lpdword(@NumValues),lpdword(@MaxValueLen),
-              lpdword(@MaxDataLen),nil,@winFileTime)=ERROR_SUCCESS;
+              lpdword(@MaxDataLen),nil,@winFileTime);
+    Result:=FLastError=ERROR_SUCCESS;          
+    end;          
   if Result then
   if Result then
   begin
   begin
     FileTimeToSystemTime(@winFileTime, @sysTime);
     FileTimeToSystemTime(@winFileTime, @sysTime);
@@ -196,16 +206,19 @@ begin
   If CanCreate then
   If CanCreate then
     begin
     begin
     Handle:=0;
     Handle:=0;
-    Result:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),P,0,'',
+    FLastError:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),P,0,'',
 
 
                            REG_OPTION_NON_VOLATILE,
                            REG_OPTION_NON_VOLATILE,
                            fAccess,SecurityAttributes,Handle,
                            fAccess,SecurityAttributes,Handle,
-                           pdword(@Disposition))=ERROR_SUCCESS
-
+                           pdword(@Disposition));
+    Result:=FLastError=ERROR_SUCCESS;
     end
     end
   else
   else
-    Result:=RegOpenKeyExA(GetBaseKey(RelativeKey(Key)),
-                         P,0,fAccess,Handle)=ERROR_SUCCESS;
+    begin
+    FLastError:=RegOpenKeyExA(GetBaseKey(RelativeKey(Key)),
+                         P,0,fAccess,Handle);
+    Result:=FLastError=ERROR_SUCCESS;
+    end;                     
   If Result then begin
   If Result then begin
     if RelativeKey(Key) then
     if RelativeKey(Key) then
       S:=CurrentPath + Key
       S:=CurrentPath + Key
@@ -238,7 +251,8 @@ begin
 {$ifdef WinCE}
 {$ifdef WinCE}
   Result:=False;
   Result:=False;
 {$else}
 {$else}
-  Result:=RegConnectRegistryA(PChar(UNCName),RootKey,newroot)=ERROR_SUCCESS;
+  FLastError:=RegConnectRegistryA(PChar(UNCName),RootKey,newroot);
+  Result:=FLastError=ERROR_SUCCESS;
   if Result then begin
   if Result then begin
     RootKey:=newroot;
     RootKey:=newroot;
     PWinRegData(FSysData)^.RootKeyOwned:=True;
     PWinRegData(FSysData)^.RootKeyOwned:=True;
@@ -371,7 +385,8 @@ begin
     rdBinary       : RegDataType:=REG_BINARY;
     rdBinary       : RegDataType:=REG_BINARY;
   end;
   end;
   P:=PChar(Name);
   P:=PChar(Name);
-  Result:=RegSetValueExA(fCurrentKey,P,0,RegDataType,Buffer,BufSize)=ERROR_SUCCESS;
+  FLastError:=RegSetValueExA(fCurrentKey,P,0,RegDataType,Buffer,BufSize);
+  Result:=FLastError=ERROR_SUCCESS;
 end;
 end;
 
 
 procedure TRegistry.RenameValue(const OldName, NewName: string);
 procedure TRegistry.RenameValue(const OldName, NewName: string);
@@ -417,3 +432,11 @@ begin
   fRootKey := Value;
   fRootKey := Value;
 end;
 end;
 
 
+function TRegistry.GetLastErrorMsg: string;
+begin
+  if FLastError <> ERROR_SUCCESS then
+    Result:=SysErrorMessage(FLastError)
+  else
+    Result:='';
+end;
+

+ 15 - 9
packages/fcl-registry/src/xregreg.inc

@@ -83,7 +83,7 @@ begin
   Dec(FRefCount);
   Dec(FRefCount);
 end;
 end;
 
 
-Procedure TRegistry.SysRegCreate;
+procedure TRegistry.SysRegCreate;
 var s : string;
 var s : string;
 begin
 begin
   s:=includetrailingpathdelimiter(GetAppConfigDir(GlobalXMLFile));
   s:=includetrailingpathdelimiter(GetAppConfigDir(GlobalXMLFile));
@@ -92,7 +92,7 @@ begin
   TXmlRegistry(FSysData).AutoFlush:=False;
   TXmlRegistry(FSysData).AutoFlush:=False;
 end;
 end;
 
 
-Procedure TRegistry.SysRegFree;
+procedure TRegistry.SysRegFree;
 
 
 begin
 begin
   if Assigned(FSysData) then
   if Assigned(FSysData) then
@@ -106,13 +106,13 @@ begin
   Result:=TXmlRegistry(FSysData).CreateKey(Key);
   Result:=TXmlRegistry(FSysData).CreateKey(Key);
 end;
 end;
 
 
-function TRegistry.DeleteKey(const Key: String): Boolean;
+function TRegistry.DeleteKey(const Key: string): Boolean;
 
 
 begin
 begin
   Result:=TXMLRegistry(FSysData).DeleteKey(Key);
   Result:=TXMLRegistry(FSysData).DeleteKey(Key);
 end;
 end;
 
 
-function TRegistry.DeleteValue(const Name: String): Boolean;
+function TRegistry.DeleteValue(const Name: string): Boolean;
 begin
 begin
   Result:=TXmlRegistry(FSysData).DeleteValue(Name);
   Result:=TXmlRegistry(FSysData).DeleteValue(Name);
 end;
 end;
@@ -138,7 +138,8 @@ begin
 end;
 end;
 
 
 
 
-function TRegistry.GetDataInfo(const ValueName: String; var Value: TRegDataInfo): Boolean;
+function TRegistry.GetDataInfo(const ValueName: string; var Value: TRegDataInfo
+  ): Boolean;
 
 
 Var
 Var
   Info : TDataInfo;
   Info : TDataInfo;
@@ -164,7 +165,7 @@ begin
       end;
       end;
 end;
 end;
 
 
-function TRegistry.GetKey(const Key: String): HKEY;
+function TRegistry.GetKey(const Key: string): HKEY;
 begin
 begin
   Result := 0;
   Result := 0;
 end;
 end;
@@ -241,7 +242,7 @@ begin
   Result := TXmlRegistry(FSysData).ValueExists(Name);
   Result := TXmlRegistry(FSysData).ValueExists(Name);
 end;
 end;
 
 
-procedure TRegistry.ChangeKey(Value: HKey; const Path: String);
+procedure TRegistry.ChangeKey(Value: HKey; const Path: string);
 begin
 begin
 
 
 end;
 end;
@@ -257,8 +258,8 @@ begin
 end;
 end;
 
 
 
 
-Function TRegistry.SysPutData(const Name: string; Buffer: Pointer;
-  BufSize: Integer; RegData: TRegDataType) : Boolean;
+function TRegistry.SysPutData(const Name: string; Buffer: Pointer;
+  BufSize: Integer; RegData: TRegDataType): Boolean;
 
 
 Var
 Var
   DataType : TDataType;
   DataType : TDataType;
@@ -309,6 +310,11 @@ begin
   fRootKey := Value;
   fRootKey := Value;
 end;
 end;
 
 
+function TRegistry.GetLastErrorMsg: string;
+begin
+  Result:='';
+end;
+
 procedure TRegistry.CloseKey;
 procedure TRegistry.CloseKey;
 
 
 begin
 begin