Repository URL to install this package:
Version:
3.0.0 ▾
|
{ ---------------------------------------------------------------------
System dependent Registry implementation - using XML file.
---------------------------------------------------------------------}
uses xmlreg;
Const
XFileName = 'reg.xml';
Procedure TRegistry.SysRegCreate;
var s : string;
begin
s:=includetrailingpathdelimiter(GetAppConfigDir(GlobalXMLFile));
ForceDirectories(s);
FSysData:=TXMLRegistry.Create(s+XFileName);
TXmlRegistry(FSysData).AutoFlush:=False;
end;
Procedure TRegistry.SysRegFree;
begin
if Assigned(FSysData) then
TXMLRegistry(FSysData).Flush;
TXMLRegistry(FSysData).Free;
end;
function TRegistry.SysCreateKey(const Key: String): Boolean;
begin
Result:=TXmlRegistry(FSysData).CreateKey(Key);
end;
function TRegistry.DeleteKey(const Key: String): Boolean;
begin
Result:=TXMLRegistry(FSysData).DeleteKey(Key);
end;
function TRegistry.DeleteValue(const Name: String): Boolean;
begin
Result:=TXmlRegistry(FSysData).DeleteValue(Name);
end;
function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
BufSize: Integer; var RegData: TRegDataType): Integer;
Var
DataType : TDataType;
begin
Result:=BufSize;
If TXmlregistry(FSysData).GetValueData(Name,DataType,Buffer^,Result) then
begin
Case DataType of
dtUnknown : RegData:=rdUnknown;
dtString : RegData:=rdString;
dtDWord : RegData:=rdInteger;
dtBinary : RegData:=rdBinary;
end;
end
else
Result:=-1;
end;
function TRegistry.GetDataInfo(const ValueName: String; var Value: TRegDataInfo): Boolean;
Var
Info : TDataInfo;
begin
Result := TXmlRegistry(FSysData).GetValueInfo(ValueName,Info);
If Not Result then
With Value do
begin
RegData:=rdunknown;
DataSize:=0;
end
else
With Value do
begin
Case Info.DataType of
dtUnknown: RegData:=rdUnknown;
dtDword : Regdata:=rdInteger;
dtString : RegData:=rdString;
dtBinary : RegData:=rdBinary;
end;
DataSize:=Info.DataSize;
end;
end;
function TRegistry.GetKey(const Key: String): HKEY;
begin
Result := 0;
end;
function TRegistry.GetKeyInfo(var Value: TRegKeyInfo): Boolean;
Var
Info : TKeyInfo;
begin
Result:=TXmlRegistry(FSysData).GetKeyInfo(info);
If Result then
With Value,Info do
begin
NumSubKeys:=SubKeys;
MaxSubKeyLen:=SubKeyLen;
NumValues:= Values;
MaxValueLen:=ValueLen;
MaxDataLen:=DataLen;
FileTime:=FTime;
end;
end;
function TRegistry.KeyExists(const Key: string): Boolean;
begin
Result:=TXmlRegistry(FSysData).KeyExists(Key);
end;
function TRegistry.LoadKey(const Key, FileName: string): Boolean;
begin
Result := False;
end;
function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
begin
Result:=TXmlRegistry(FSysData).SetKey(Key,CanCreate);
FCurrentKey:=1;
end;
function TRegistry.OpenKeyReadOnly(const Key: string): Boolean;
begin
Result:=TXmlRegistry(FSysData).SetKey(Key,False);
end;
function TRegistry.RegistryConnect(const UNCName: string): Boolean;
begin
Result := True;
end;
function TRegistry.ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
begin
Result := False;
end;
function TRegistry.RestoreKey(const Key, FileName: string): Boolean;
begin
Result := False;
end;
function TRegistry.SaveKey(const Key, FileName: string): Boolean;
begin
Result := False;
end;
function TRegistry.UnLoadKey(const Key: string): Boolean;
begin
Result := False;
end;
function TRegistry.ValueExists(const Name: string): Boolean;
begin
Result := TXmlRegistry(FSysData).ValueExists(Name);
end;
procedure TRegistry.ChangeKey(Value: HKey; const Path: String);
begin
end;
procedure TRegistry.GetKeyNames(Strings: TStrings);
begin
TXmlRegistry(FSysData).EnumSubKeys(Strings);
end;
procedure TRegistry.GetValueNames(Strings: TStrings);
begin
TXmlRegistry(FSysData).EnumValues(Strings);
end;
Function TRegistry.SysPutData(const Name: string; Buffer: Pointer;
BufSize: Integer; RegData: TRegDataType) : Boolean;
Var
DataType : TDataType;
begin
Case RegData of
rdUnknown : DataType := dtUnknown;
rdString,rdExpandString : DataType := dtString;
rdInteger : DataType := dtDword;
rdBinary : DataType := dtBinary;
end;
Result:=TXMLRegistry(FSysData).SetValueData(Name,DataType,Buffer^,BufSize);
end;
procedure TRegistry.RenameValue(const OldName, NewName: string);
begin
TXMLRegistry(FSysData).RenameValue(OldName,NewName);
end;
procedure TRegistry.SetCurrentKey(Value: HKEY);
begin
fCurrentKey := Value;
end;
procedure TRegistry.SetRootKey(Value: HKEY);
Var
S: String;
begin
If (Value=HKEY_CLASSES_ROOT) then
S:='HKEY_CLASSES_ROOT'
else if (Value=HKEY_CURRENT_USER) then
S:='HKEY_CURRENT_USER'
else if (Value=HKEY_LOCAL_MACHINE) then
S:='HKEY_LOCAL_MACHINE'
else if (Value=HKEY_USERS) then
S:='HKEY_USERS'
else if Value=HKEY_PERFORMANCE_DATA then
S:='HKEY_PERFORMANCE_DATA'
else if (Value=HKEY_CURRENT_CONFIG) then
S:='HKEY_CURRENT_CONFIG'
else if (Value=HKEY_DYN_DATA) then
S:='HKEY_DYN_DATA'
else
S:=Format('Key%d',[Value]);
TXmlRegistry(FSysData).SetRootKey(S);
fRootKey := Value;
end;
procedure TRegistry.CloseKey;
begin
// CloseKey is called from destructor, which includes cases of failed construction.
// FSysData may be unassigned at this point.
if Assigned(FSysData) then
begin
TXMLRegistry(FSysData).Flush;
TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
end;
end;
procedure TRegistry.CloseKey(key:HKEY);
begin
if Assigned(FSysData) then
begin
TXMLRegistry(FSysData).Flush;
TXMLRegistry(FSysData).SetRootKey(TXMLRegistry(FSysData).RootKey);
end;
end;