mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-29 20:00:19 +02:00
* Added LastError and LastErrorMsg (bug ID 29681)
git-svn-id: trunk@33348 -
This commit is contained in:
michael
parent
fb984ad18a
commit
9501faa00b
@ -42,8 +42,11 @@ type
|
||||
TRegistry
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
{ TRegistry }
|
||||
|
||||
TRegistry = class(TObject)
|
||||
private
|
||||
FLastError: Longint;
|
||||
FStringSizeIncludesNull : Boolean;
|
||||
FSysData : Pointer;
|
||||
fAccess: LongWord;
|
||||
@ -51,6 +54,7 @@ type
|
||||
fRootKey: HKEY;
|
||||
fLazyWrite: Boolean;
|
||||
fCurrentPath: string;
|
||||
function GetLastErrorMsg: string;
|
||||
procedure SetRootKey(Value: HKEY);
|
||||
Procedure SysRegCreate;
|
||||
Procedure SysRegFree;
|
||||
@ -122,6 +126,8 @@ type
|
||||
property LazyWrite: Boolean read fLazyWrite write fLazyWrite;
|
||||
property RootKey: HKEY read fRootKey write SetRootKey;
|
||||
Property StringSizeIncludesNull : Boolean read FStringSizeIncludesNull;
|
||||
property LastError: Longint read FLastError; platform;
|
||||
property LastErrorMsg: string read GetLastErrorMsg; platform;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
@ -225,7 +231,7 @@ implementation
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
|
||||
Constructor TRegistry.Create;
|
||||
constructor TRegistry.Create;
|
||||
|
||||
begin
|
||||
inherited Create;
|
||||
@ -236,21 +242,21 @@ begin
|
||||
SysRegCreate;
|
||||
end;
|
||||
|
||||
Constructor TRegistry.Create(aaccess:longword);
|
||||
constructor TRegistry.Create(aaccess: longword);
|
||||
|
||||
begin
|
||||
Create;
|
||||
FAccess := aaccess;
|
||||
end;
|
||||
|
||||
Destructor TRegistry.Destroy;
|
||||
destructor TRegistry.Destroy;
|
||||
begin
|
||||
CloseKey;
|
||||
SysRegFree;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TRegistry.CreateKey(const Key: String): Boolean;
|
||||
function TRegistry.CreateKey(const Key: string): Boolean;
|
||||
|
||||
begin
|
||||
Result:=SysCreateKey(Key);
|
||||
@ -266,8 +272,8 @@ begin
|
||||
Result := RootKey;
|
||||
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
|
||||
Result:=SysGetData(Name,Buffer,BufSize,RegData);
|
||||
If (Result=-1) then
|
||||
@ -283,7 +289,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TRegistry.GetDataSize(const ValueName: String): Integer;
|
||||
function TRegistry.GetDataSize(const ValueName: string): Integer;
|
||||
|
||||
Var
|
||||
Info: TRegDataInfo;
|
||||
@ -305,7 +311,7 @@ begin
|
||||
Result:=Info.RegData;
|
||||
end;
|
||||
|
||||
Function TRegistry.HasSubKeys: Boolean;
|
||||
function TRegistry.HasSubKeys: Boolean;
|
||||
|
||||
Var
|
||||
Info : TRegKeyInfo;
|
||||
|
||||
@ -48,7 +48,7 @@ Var
|
||||
begin
|
||||
SecurityAttributes := Nil;
|
||||
P:=PrepKey(Key);
|
||||
Result:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),
|
||||
FLastError:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),
|
||||
P,
|
||||
0,
|
||||
'',
|
||||
@ -56,7 +56,8 @@ begin
|
||||
KEY_ALL_ACCESS,
|
||||
SecurityAttributes,
|
||||
Handle,
|
||||
@Disposition) = ERROR_SUCCESS;
|
||||
@Disposition);
|
||||
Result:=FLastError=ERROR_SUCCESS;
|
||||
RegCloseKey(Handle);
|
||||
end;
|
||||
|
||||
@ -66,12 +67,14 @@ Var
|
||||
P: PChar;
|
||||
begin
|
||||
P:=PRepKey(Key);
|
||||
Result:=RegDeleteKeyA(GetBaseKey(RelativeKey(Key)),P)=ERROR_SUCCESS;
|
||||
FLastError:=RegDeleteKeyA(GetBaseKey(RelativeKey(Key)),P);
|
||||
Result:=FLastError=ERROR_SUCCESS;
|
||||
end;
|
||||
|
||||
function TRegistry.DeleteValue(const Name: String): Boolean;
|
||||
begin
|
||||
Result := RegDeleteValueA(fCurrentKey, @Name[1]) = ERROR_SUCCESS;
|
||||
FLastError:= RegDeleteValueA(fCurrentKey, @Name[1]);
|
||||
Result:=FLastError=ERROR_SUCCESS;
|
||||
end;
|
||||
|
||||
function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
|
||||
@ -82,8 +85,9 @@ Var
|
||||
|
||||
begin
|
||||
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
|
||||
else
|
||||
begin
|
||||
@ -109,7 +113,10 @@ Var
|
||||
begin
|
||||
P:=PChar(ValueName);
|
||||
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
|
||||
begin
|
||||
Value.RegData := rdUnknown;
|
||||
@ -129,9 +136,9 @@ begin
|
||||
if not(Rel) then
|
||||
Delete(S,1,1);
|
||||
{$ifdef WinCE}
|
||||
RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result);
|
||||
FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result);
|
||||
{$else WinCE}
|
||||
RegOpenKeyEx(GetBaseKey(Rel),PChar(S),0,FAccess,Result);
|
||||
FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PChar(S),0,FAccess,Result);
|
||||
{$endif WinCE}
|
||||
end;
|
||||
|
||||
@ -143,9 +150,12 @@ var
|
||||
begin
|
||||
FillChar(Value, SizeOf(Value), 0);
|
||||
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(@MaxDataLen),nil,@winFileTime)=ERROR_SUCCESS;
|
||||
lpdword(@MaxDataLen),nil,@winFileTime);
|
||||
Result:=FLastError=ERROR_SUCCESS;
|
||||
end;
|
||||
if Result then
|
||||
begin
|
||||
FileTimeToSystemTime(@winFileTime, @sysTime);
|
||||
@ -196,16 +206,19 @@ begin
|
||||
If CanCreate then
|
||||
begin
|
||||
Handle:=0;
|
||||
Result:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),P,0,'',
|
||||
FLastError:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),P,0,'',
|
||||
|
||||
REG_OPTION_NON_VOLATILE,
|
||||
fAccess,SecurityAttributes,Handle,
|
||||
pdword(@Disposition))=ERROR_SUCCESS
|
||||
|
||||
pdword(@Disposition));
|
||||
Result:=FLastError=ERROR_SUCCESS;
|
||||
end
|
||||
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 RelativeKey(Key) then
|
||||
S:=CurrentPath + Key
|
||||
@ -238,7 +251,8 @@ begin
|
||||
{$ifdef WinCE}
|
||||
Result:=False;
|
||||
{$else}
|
||||
Result:=RegConnectRegistryA(PChar(UNCName),RootKey,newroot)=ERROR_SUCCESS;
|
||||
FLastError:=RegConnectRegistryA(PChar(UNCName),RootKey,newroot);
|
||||
Result:=FLastError=ERROR_SUCCESS;
|
||||
if Result then begin
|
||||
RootKey:=newroot;
|
||||
PWinRegData(FSysData)^.RootKeyOwned:=True;
|
||||
@ -371,7 +385,8 @@ begin
|
||||
rdBinary : RegDataType:=REG_BINARY;
|
||||
end;
|
||||
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;
|
||||
|
||||
procedure TRegistry.RenameValue(const OldName, NewName: string);
|
||||
@ -417,3 +432,11 @@ begin
|
||||
fRootKey := Value;
|
||||
end;
|
||||
|
||||
function TRegistry.GetLastErrorMsg: string;
|
||||
begin
|
||||
if FLastError <> ERROR_SUCCESS then
|
||||
Result:=SysErrorMessage(FLastError)
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
|
||||
@ -83,7 +83,7 @@ begin
|
||||
Dec(FRefCount);
|
||||
end;
|
||||
|
||||
Procedure TRegistry.SysRegCreate;
|
||||
procedure TRegistry.SysRegCreate;
|
||||
var s : string;
|
||||
begin
|
||||
s:=includetrailingpathdelimiter(GetAppConfigDir(GlobalXMLFile));
|
||||
@ -92,7 +92,7 @@ begin
|
||||
TXmlRegistry(FSysData).AutoFlush:=False;
|
||||
end;
|
||||
|
||||
Procedure TRegistry.SysRegFree;
|
||||
procedure TRegistry.SysRegFree;
|
||||
|
||||
begin
|
||||
if Assigned(FSysData) then
|
||||
@ -106,13 +106,13 @@ begin
|
||||
Result:=TXmlRegistry(FSysData).CreateKey(Key);
|
||||
end;
|
||||
|
||||
function TRegistry.DeleteKey(const Key: String): Boolean;
|
||||
function TRegistry.DeleteKey(const Key: string): Boolean;
|
||||
|
||||
begin
|
||||
Result:=TXMLRegistry(FSysData).DeleteKey(Key);
|
||||
end;
|
||||
|
||||
function TRegistry.DeleteValue(const Name: String): Boolean;
|
||||
function TRegistry.DeleteValue(const Name: string): Boolean;
|
||||
begin
|
||||
Result:=TXmlRegistry(FSysData).DeleteValue(Name);
|
||||
end;
|
||||
@ -138,7 +138,8 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TRegistry.GetDataInfo(const ValueName: String; var Value: TRegDataInfo): Boolean;
|
||||
function TRegistry.GetDataInfo(const ValueName: string; var Value: TRegDataInfo
|
||||
): Boolean;
|
||||
|
||||
Var
|
||||
Info : TDataInfo;
|
||||
@ -164,7 +165,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRegistry.GetKey(const Key: String): HKEY;
|
||||
function TRegistry.GetKey(const Key: string): HKEY;
|
||||
begin
|
||||
Result := 0;
|
||||
end;
|
||||
@ -241,7 +242,7 @@ begin
|
||||
Result := TXmlRegistry(FSysData).ValueExists(Name);
|
||||
end;
|
||||
|
||||
procedure TRegistry.ChangeKey(Value: HKey; const Path: String);
|
||||
procedure TRegistry.ChangeKey(Value: HKey; const Path: string);
|
||||
begin
|
||||
|
||||
end;
|
||||
@ -257,8 +258,8 @@ begin
|
||||
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
|
||||
DataType : TDataType;
|
||||
@ -309,6 +310,11 @@ begin
|
||||
fRootKey := Value;
|
||||
end;
|
||||
|
||||
function TRegistry.GetLastErrorMsg: string;
|
||||
begin
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
procedure TRegistry.CloseKey;
|
||||
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user