unit entries;
interface
uses
System.SysUtils, Classes, Windows, Contnrs;
type
PNode = ^TNode;
//Ein voerheriger Versuch
TNode =
record
Data: Pointer;
next,
prev: PNode;
end;
//So könnte Windows intern Registrydaten speichern
TEntry =
class(TObject)
private
FSubkey: AnsiString;
//Unterschlüssel
FSubkeyW: WideString;
FKeyClass: AnsiString;
//Schlüsselklasse
FKeyClassW: WideString;
FKeyValue: AnsiString;
//Schlüsselwert
FKeyValueW: WideString;
FdwOptions: DWORD;
//Optionen zur Erzeugung
FsamDesired: REGSAM;
//Optionen zum Zugriff auf den Schlüssel
FDataType: LPDWORD;
//Typ der Daten im Schlüsseleintrag
FDataLen: DWORD;
//Länge dieser Daten
FData: LPBYTE;
//Die Daten selber
function GetData: LPBYTE;
procedure SetData(
const Value: LPBYTE);
function GetNode: PNode;
procedure SetNode(
const Value: PNode);
public
constructor Create;
constructor CreateAndInit(
lpSubKey: AnsiString;
lpClass: AnsiString;
dwOptions: DWORD;
samDesired: REGSAM;
aDataType: LPDWORD=nil;
aDataLen: DWORD=0;
aData: LPBYTE=nil
);
constructor CreateAndInitW(
lpwSubKey: WideString;
lpwClass: WideString;
dwOptions: DWORD;
samDesired: REGSAM;
aDataType: LPDWORD=nil;
aDataLen: DWORD=0;
aData: LPBYTE=nil
);
destructor Destroy;
override;
property Subkey: AnsiString
read FSubKey
write FSubkey;
property KeyClass: AnsiString
read FKeyClass
write FKeyClass;
property KeyValue: AnsiString
read FKeyValue
write FKeyValue;
property dwOptions: DWORD
read FdwOptions
write FdwOptions;
property samDesired: REGSAM
read FSamDesired
write FsamDesired;
property DataType: LPDWORD
read FDataType
write FDataType;
property DataLen: DWORD
read FDataLen
write FDataLen;
property Data: LPBYTE
read GetData
write SetData;
end;
//Für jeden Subkey dann einen Registryeintrag
TEntries =
class(TObjectList)
//Subkeys
private
function GetEntries(
Index: Integer): TEntry;
procedure SetEntries(
Index: Integer;
const Value: TEntry);
public
function FindSubKey(aSubKey: AnsiString;
var Entry: TEntry): Integer;
function FindClass(aClass: AnsiString;
var Entry: TEntry): Integer;
function FindValue(aValueName: AnsiString;
var Entry: TEntry): Integer;
property Entries[
Index: Integer]: TEntry
read GetEntries
write SetEntries;
default;
end;
//Wegen der vielen Subkeys diese Klasse
TKey =
class(TObject)
private
FKey: HKEY;
//Key
FKeys: TEntries;
function GetEntries: TEntries;
procedure SetEntries(
const Value: TEntries);
function GetKeys(
Index: Integer): TEntry;
procedure SetKeys(
Index: Integer;
const Value: TEntry);
//Subkeys
public
constructor Create;
destructor Destroy;
override;
property SubKeys[
Index: Integer]: TEntry
read GetKeys
write SetKeys;
property InThe: TEntries
read FKeys
write FKeys;
property Key: HKEY
read FKey
write FKey;
end;
//Und endlich alle Keys uns Subkeys in einer Liste
TKeys =
class(TObjectList)
private
function GetKeys(
Index: Integer): TKey;
procedure SetKeys(
Index: Integer; Value: TKey);
public
constructor Create;
destructor Destroy;
override;
function AddEntry(Key: HKey; Entry: TEntry): Integer;
//Neuen Key
function AddKey(Key: TKey): Integer;
//Subkey
function AddSubKey(Key: HKey; Entry: TEntry): Integer;
//wie AddEntry
property Keys[
Index: Integer]: TKey
read GetKeys
write SetKeys;
end;
implementation
constructor TEntry.Create;
begin
inherited Create;
end;
constructor TEntry.CreateAndInit(lpSubKey, lpClass: AnsiString;
dwOptions: DWORD; samDesired: REGSAM; aDataType: LPDWORD; aDataLen: DWORD;
aData: LPBYTE);
begin
inherited Create;
FSubkey := lpSubKey;
FKeyClass := lpClass;
FdwOptions := dwOptions;
FsamDesired := samDesired;
FDataType := aDataType;
FDataLen := aDataLen;
FData := aData;
end;
constructor TEntry.CreateAndInitW(lpwSubKey, lpwClass: WideString;
dwOptions: DWORD; samDesired: REGSAM; aDataType: LPDWORD; aDataLen: DWORD;
aData: LPBYTE);
begin
inherited Create;
FSubkey := lpwSubKey;
FKeyClass := lpwClass;
FdwOptions := dwOptions;
FsamDesired := samDesired;
FDataType := aDataType;
FDataLen := aDataLen;
FData := aData;
end;
destructor TEntry.Destroy;
begin
freemem(FData,FDataLen);
inherited;
end;
function TEntry.GetData: LPBYTE;
begin
Result :=
nil;
{
if FData <> nil then
Result := FData
else Result := nil;
}
end;
function TEntry.GetNode: PNode;
begin
Result :=
nil;
end;
procedure TEntry.SetData(
const Value: LPBYTE);
begin
FData := Value;
end;
procedure TEntry.SetNode(
const Value: PNode);
begin
//War ein vorheriger Ansatz mit Nodeslist,
//den ich aber verworfen habe
end;
{ TEntries }
function TEntries.FindClass(aClass: AnsiString;
var Entry: TEntry): Integer;
var Index: Integer;
begin
Index := 0; Result := -1;
while Index < self.Count
do
begin
if TEntry(Items[
Index]).KeyClass = aClass
then
begin
Entry := TEntry(Items[
Index]);
Result :=
Index;
//Index := self.Count;
break;
//wieder break statt Index auf Count
end;
//(auch in meinem Delphi Code geändert)
inc(
Index);
end;
end;
function TEntries.FindSubKey(aSubKey: AnsiString;
var Entry: TEntry): Integer;
var Index: Integer;
begin
Index := 0; Result := -1;
while Index < self.Count
do
begin
if TEntry(Items[
Index]).Subkey = aSubKey
then
begin
Entry := TEntry(Items[
Index]);
Result :=
Index;
//Index := self.Count;
break;
//wieder break statt Index auf Count
end;
//(auch in meinem Delphi Code geändert)
inc(
Index);
end;
end;
function TEntries.FindValue(aValueName: AnsiString;
var Entry: TEntry): Integer;
var Index: Integer;
begin
Index := 0; Result := -1;
while Index < self.Count
do
begin
if TEntry(Items[
Index]).KeyValue = aValueName
then
begin
Entry := TEntry(Items[
Index]);
Result :=
Index;
//Index := self.Count;
break;
//wieder break statt Index auf Count
end;
//(auch in meinem Delphi Code geändert)
inc(
Index);
end;
end;
function TEntries.GetEntries(
Index: Integer): TEntry;
begin
if (
Index >= 0)
and (
Index < Count)
then Result := TEntry(Items[
Index])
else Result :=
nil;
end;
procedure TEntries.SetEntries(
Index: Integer;
const Value: TEntry);
begin
Delete(
Index);
Insert(
Index,Value);
end;
{ TKeys }
function TKeys.GetKeys(
Index: Integer): TKey;
begin
Result := TKey(Items[
Index]);
end;
procedure TKeys.SetKeys(
Index: Integer; Value: TKey);
begin
Keys[
Index] := Value;
end;
function TKeys.AddEntry(Key: HKEY; Entry: TEntry): Integer;
begin
Result := AddSubKey(Key, Entry);
end;
function TKeys.AddKey(Key: TKey): Integer;
begin
Result :=
inherited Add(Key);
end;
function TKeys.AddSubKey(Key: HKEY; Entry: TEntry): Integer;
var Index,subix: Integer;
begin
Index := 0; Result := -1;
//so jetzt ist Result auf jeden Fall definiert (auch in meinem Delphi Code geändert)
while Index < Count
do
begin
if TKey(Items[
Index]).FKey = Key
then
begin
TKey(Items[
Index]).inThe.Add(Entry);
Result :=
Index;
Index := Count;
break;
end;
Inc(
Index);
end;
end;
constructor TKeys.Create;
begin
inherited Create;
end;
destructor TKeys.Destroy;
begin
inherited;
end;
{ TKey }
constructor TKey.Create;
begin
inherited Create;
end;
destructor TKey.Destroy;
begin
inherited;
end;
function TKey.GetEntries: TEntries;
begin
Result := FKeys;
end;
function TKey.GetKeys(
Index: Integer): TEntry;
begin
Result := FKeys.GetEntries(
Index);
end;
procedure TKey.SetEntries(
const Value: TEntries);
begin
FKeys.Assign(Value);
end;
procedure TKey.SetKeys(
Index: Integer;
const Value: TEntry);
begin
FKeys.SetEntries(
Index,Value);
end;
end.