|
Registriert seit: 26. Nov 2004 Ort: Dresden 275 Beiträge Delphi 10.3 Rio |
#1
Hallo!
Ich habe folgende Unit erstellt, will wissen wie Windows intern Registrydaten speichert. Ob es Windows ganz genau so macht, weiß ich natürlich nicht, aber ich versuche mir vorzustellen, wie das Windows intern machen könnte.
Delphi-Quellcode:
Ich kann aber die Werte nach Füllen der Liste nicht wieder auslesen.
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. Warum geht das nicht, ich sehr den Fehler nicht. Mein Testprogramm sieht so aus:
Delphi-Quellcode:
Bei der Ausgabe erhalte ich eine EAccessviolation, wohl wird mein Key nicht wiedergefunden, Entr hat den Wert NIL!
program EntryTest;
{$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, Windows, Entries; var AKey: TKey; Keys: TKeys; Entr: TEntry; begin try { TODO -oUser -cConsole Main : Code hier einfügen } Entr := TEntry.Create; Entr.Subkey := 'Erster Testschlüssle'; AKey := TKey.Create; AKey.Key := 1111; Keys := TKeys.Create; Keys.AddKey(AKey); Keys.AddEntry(1111,Entr); Writeln('Mein Ergebnis der Eingabe:'); TKey(Keys.Keys[0])..inThe.FindSubKey(Entr.Subkey, Entr); if Entr <> nil then Writeln('Gefundener Key: ', Entr.Subkey); Writeln('Zurück mit Enter ... '); Readln; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end. Der Delphi Debugger hält danach bei TList.Add() an Warum? . Geändert von delphifan2004 (25. Okt 2020 um 00:02 Uhr) |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |