home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Softwarová Záchrana 3
/
Softwarova-zachrana-3.bin
/
StartRight
/
source.zip
/
UnitMyRegistry.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2004-09-30
|
9KB
|
330 lines
unit UnitMyRegistry;
{
Purpose:
Remove the default behavoir of ReadKeyReadOnly making the Registry
change to readonly access - no matter the style or OpenKey used.
}
interface
uses Registry, Windows, Classes;
type TMyRegistry = class(TRegistry)
public
procedure CloseKey;
function ReadString(value, default : string) : string; overload;
function ReadBool(value : string; default : boolean) : boolean; overload;
function ReadInteger(value : string; default : Integer) : integer; overload;
function ValueExistsString(key : string; value : string; var data : string) : boolean;
function ValueExistsInteger(key : string; value : string; var data : integer) : boolean;
procedure EraseKey(HKEYVal : HKEY; basekey : string; key : string); overload;
procedure EraseKey(basekey : string; key : string); overload;
procedure GetValues(
HKEYVal : HKEY; key : string; var names : TStringList); overload;
procedure GetValues(key : string; var names : TStringList); overload;
procedure SetDataString(
HKEYVal : HKEY; key : string;
value : string; data : string;
canCreate : boolean = true); overload;
procedure SetDataString(
key : string;
value : string; data : string;
canCreate : boolean = true); overload;
procedure SetDataInteger(
HKEYVal : HKEY; key : string;
value : string; data : integer;
canCreate : boolean = true); overload;
procedure SetDataInteger(
key : string;
value : string; data : integer;
canCreate : boolean = true); overload;
function GetDataString(
HKEYVal : HKEY; key : string;
value : string) : string; overload;
function GetDataString(
key : string;
value : string) : string; overload;
function GetDataString(
HKEYVal : HKEY; key : string;
value : string; data : string) : string; overload;
function GetDataInteger(
HKEYVal : HKEY; key : string;
value : string) : integer; overload;
function GetDataInteger(
key : string;
value : string) : integer; overload;
function GetDataInteger(
HKEYVal : HKEY; key : string;
value : string; data : integer) : integer; overload;
function DeleteDataString(
HKEYVal : HKEY; key : string;
value : string) : string; overload;
function DeleteDataString(
key : string;
value : string) : string; overload;
end;
implementation
{ TMyRegistry }
uses SysUtils;
procedure TMyRegistry.SetDataString(
HKEYVal : HKEY; key : string;
value : string; data : string;
canCreate : boolean = true);
begin
self.RootKey := HKEYVal;
if self.OpenKey(key, canCreate) then begin
try
self.WriteString(value, data);
self.CloseKey;
except on e : Exception do
begin
self.CloseKey;
raise Exception.Create(e.Message);
end;
end;
end else begin
raise Exception.Create('Unable to open : ' + key);
end;
end;
procedure TMyRegistry.SetDataString(
key : string;
value : string; data : string;
canCreate : boolean = true);
begin
SetDataString(HKEY_LOCAL_MACHINE, key, value, data, CanCreate);
end;
procedure TMyRegistry.SetDataInteger(HKEYVal: HKEY; key, value: string;
data: integer; canCreate: boolean);
begin
self.RootKey := HKEYVal;
if self.OpenKey(key, canCreate) then begin
self.WriteInteger(value, data);
self.CloseKey;
end;
end;
procedure TMyRegistry.SetDataInteger(key, value: string; data: integer;
canCreate: boolean);
begin
SetDataInteger(HKEY_LOCAL_MACHINE, key, value, data, CanCreate);
end;
function TMyRegistry.GetDataString(
HKEYVal : HKEY; key : string;
value : string) : string;
begin
result := '';
self.RootKey := HKEYVal;
if self.OpenKeyReadOnly(key) then begin
try
if self.ValueExists(value) then begin
result := self.ReadString(value);
end;
finally
self.CloseKey;
end;
end;
end;
function TMyRegistry.GetDataString(
key : string;
value : string) : string;
begin
result := GetDataString(HKEY_LOCAL_MACHINE, key, value);
end;
function TMyRegistry.GetDataString(
HKEYVal : HKEY; key : string;
value : string; data : string) : string;
begin
self.RootKey := HKEYVal;
if self.OpenKey(key, true) then begin
result := self.ReadString(value, data);
self.CloseKey;
end;
end;
function TMyRegistry.DeleteDataString(
HKEYVal : HKEY; key : string;
value : string) : string;
begin
result := '';
self.RootKey := HKEYVal;
if self.OpenKey(key, false) then begin
if self.ValueExists(value) then begin
result := self.ReadString(value);
self.DeleteValue(value);
end;
self.CloseKey;
end;
end;
function TMyRegistry.DeleteDataString(
key : string;
value : string) : string;
begin
result := DeleteDataString(HKEY_LOCAL_MACHINE, key, value);
end;
function TMyRegistry.GetDataInteger(HKEYVal: HKEY; key,
value: string): integer;
begin
result := -1;
self.RootKey := HKEYVal;
if self.OpenKey(key, true) then begin
if self.ValueExists(value) then begin
result := self.ReadInteger(value);
end;
self.CloseKey;
end;
end;
function TMyRegistry.GetDataInteger(key, value: string): integer;
begin
result := GetDataInteger(HKEY_LOCAL_MACHINE, key, value);
end;
function TMyRegistry.GetDataInteger(HKEYVal: HKEY; key, value: string;
data: integer): integer;
begin
result := -1;
self.RootKey := HKEYVal;
if self.OpenKey(key, true) then begin
result := self.ReadInteger(value, data);
self.CloseKey;
end;
end;
procedure TMyRegistry.CloseKey;
begin
inherited CloseKey;
self.Access := KEY_ALL_ACCESS;
end;
function TMyRegistry.ReadBool(value: string; default: boolean): boolean;
begin
if self.ValueExists(value) then begin
result := inherited ReadBool(value);
end else begin
self.WriteBool(value, default);
result := default;
end;
end;
function TMyRegistry.ReadInteger(value: string; default: Integer): integer;
begin
if self.ValueExists(value) then begin
result := inherited ReadInteger(value);
end else begin
self.WriteInteger(value, default);
result := default;
end;
end;
function TMyRegistry.ReadString(value, default: string) : string;
begin
if self.ValueExists(value) then begin
result := inherited ReadString(value);
end else begin
self.WriteString(value, default);
result := default;
end;
end;
procedure TMyRegistry.EraseKey(basekey, key: string);
begin
EraseKey(HKEY_LOCAL_MACHINE, basekey, key);
end;
procedure TMyRegistry.EraseKey(HKEYVal: HKEY; basekey, key: string);
begin
self.RootKey := HKEYVal;
if (self.OpenKey(basekey, false)) then begin
try
if self.KeyExists(key) then begin
self.DeleteKey(key);
end;
self.CreateKey(key);
finally
self.CloseKey;
end;
end;
end;
function TMyRegistry.ValueExistsInteger(key, value: string;
var data: integer): boolean;
begin
result := false; // default to failure
self.RootKey := HKEY_LOCAL_MACHINE;
if not self.OpenKeyReadOnly(Key) then EXIT;
if self.ValueExists(value) then begin
data := self.ReadInteger(value);
result := true;
end;
self.CloseKey;
end;
function TMyRegistry.ValueExistsString(key, value: string;
var data: string): boolean;
begin
result := false; // default to failure
self.RootKey := HKEY_LOCAL_MACHINE;
if not self.OpenKeyReadOnly(Key) then EXIT;
if self.ValueExists(value) then begin
data := self.ReadString(value);
result := true;
end;
self.CloseKey;
end;
procedure TMyRegistry.GetValues(HKEYVal: HKEY; key: string; var names : TStringList);
begin
self.RootKey := HKEYVal;
if self.OpenKeyReadOnly(key) then begin
self.GetValueNames(names);
self.CloseKey;
end;
end;
procedure TMyRegistry.GetValues(key: string; var names : TStringList);
begin
self.GetValues(HKEY_LOCAL_MACHINE, key, names);
end;
end.