![]() |
Seltsame Exception
Ich habe eine Klasse TProfileWriter zum Massenschreiben von Registryeinträgen.
Delphi-Quellcode:
TProfileWriter = class
private Reg: TRegistry; Keys: TStringList; procedure FindKeys; public constructor Create; destructor Destroy; override; procedure WriteBinaryValue(const Name: string; var Value: array of byte); procedure WriteProfile(const Profile: TProfile); end;
Delphi-Quellcode:
Wenn ich jetzt in einem ActionExecute-Event des Hauptforumulars WriteProfile mit einem Profil (ebenfalls eine Klasse mit einer Stringlist "Settings") aufrufe, kommt es in folgender Zeile zu einer Exception:
procedure TProfileWriter.WriteBinaryValue(const Name: string; var Value: array of byte);
var i: cardinal; begin if (Keys.Count > 0) and (Length(Value) > 0) then for i := 0 to Keys.Count - 1 do begin Reg.OpenKey(Keys.Strings[i], false); Reg.WriteBinaryData(Name,Value[0],Length(Value)); Reg.CloseKey; end; end; procedure TProfileWriter.WriteProfile(const Profile: TProfile); var pc: PAnsiChar; a: array of byte; i: cardinal; begin SetLength(a, 4); GetMem(pc, 5); try FillChar(pc,5,0); with Profile.Settings do begin if Count > 0 then for i := 0 to Count - 1 do begin pc := PChar(LowerCase(ValueFromIndex[i])); HexToBin(pc,pc,4); CopyMemory(@a[0],pc,4); WriteBinaryValue(Names[i],a); end; end; finally FreeMem(pc); end; end;
Delphi-Quellcode:
if (Keys.Count > 0) and (Length(Value) > 0) then
Zitat:
Wenn ich WriteBinaryValue im OnCreate des Hauptformulars zum Test so aufrufe, tritt die Exception nicht auf und die Registryeinträge werden korrekt geschrieben. Anscheinend ist Keys = nil beim Aufruf aus WriteProfile, aber das dürfte doch gar nicht sein!? :? |
Re: Seltsame Exception
Erzeugst du auch eine Instanz der Klasse?
|
Re: Seltsame Exception
Ja.
Delphi-Quellcode:
procedure TMainForm.FormCreate(Sender: TObject);
var F: TSearchRec; i: integer; item: TListItem; begin ProfileWriter := TProfileWriter.Create; |
Re: Seltsame Exception
Und wo wird die private variable Keys gefüllt?
|
Re: Seltsame Exception
Keys wird im Konstruktor von TProfileWriter erstellt.
Delphi-Quellcode:
FindKeys füllt die Stringliste Keys mit Einträgen.
constructor TProfileWriter.Create;
begin inherited; Reg := TRegistry.Create; Keys := TStringList.Create; Reg.RootKey := HKEY_LOCAL_MACHINE; FindKeys; end; |
Re: Seltsame Exception
Hm, ich geb dir mal recht, wenn du die Instanzen so erzeugst wie gepostet dürfte dass nicht sein. Dann solltest du gucken, ob a) das was scheint auch so ist, am besten ein
Delphi-Quellcode:
vor die Zeile mit dem Fehler (mag überflüssig erscheinen, aber so kann man halt leicht auf Nummer sicher gehen!), ok, Debugger und den Wert von Keys tuts natürlich auch. Und wenn der sicher nil / 0 ist, dann muss
if not assigned(keys) then
begin ShowMessage('NACHRICHT'); end; a) die Zeile Keys = TStringList.Create nie aufgerufen werden oder b) Keys irgendwo wieder freigegeben werden, bevor der Aufruf von WriteBinaryValue auftritt. Dann heißt's nach dieser Stelle suchen. Vielleicht ein versehentlich zu frühes Free oder ein setzen von Keys = nil oder oder so. F c) fällt mir gerade ein, ActionExecute könnte vor dem OnCreate Ereignis aufgerufen werden. Dann solltest du vor dem Aufruf prüfen ob Keys schon angelegt wurde oder (wozu ich dir dann raten würde) die Ereignisbehandlungsroutine (also dass was zu OnActionExecute gehört) erst im OnCreate zuweisen (nicht im Objekt Inspektor). Gruß Der Unwissende |
Re: Seltsame Exception
Zitat:
Zitat:
Zitat:
Zitat:
---- Seltsam. Mache ich die Methoden virtuell, tritt der Fehler schon hier auf:
Delphi-Quellcode:
WriteBinaryValue(Names[i],a);
|
Re: Seltsame Exception
Etwas dumme Frage, aber rufst du es in einem OnClick Event des Buttons auf, oder im OnActionExecute des Hauptformulars? Wäre hier doch ein gewaltiger unterschied
Zitat:
|
Re: Seltsame Exception
Solangsam deutet alles darauf hin, dass du doch nicht korrekt eine Instanz von TProfileWrite erzeugst.
|
Re: Seltsame Exception
Zitat:
Ich rufe es im OnExecute der Aktion auf. Zitat:
Wenn ich WriteProfile im OnCreate aufrufe, kommt wieder der gleiche Mist. Ich denke der Fehler ist im WriteProfile. |
Re: Seltsame Exception
Ok, ich glaube ich verlier gerade ein wenig den überblick. Könntest du vielleicht das Programm posten? Das macht die Suche nach dem Fehler (denke ich) leichter.
|
Re: Seltsame Exception
Gerne.
Delphi-Quellcode:
unit MainUnit;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, XPMan, ExtCtrls, ActnList, StdActns, ComCtrls, ProfChanger; type TMainForm = class(TForm) ButtonPanel: TPanel; MainPanel: TPanel; XPManifest: TXPManifest; DescriptionPanel: TPanel; ProfileTitleLabel: TLabel; ProfileDescriptionMemo: TMemo; ExitButton: TButton; MainSplitter: TSplitter; ApplyButton: TButton; ActionList: TActionList; FileExit: TFileExit; ProfileApply: TAction; ContainerPanel: TPanel; StatusBar: TStatusBar; ProfilesBox: TListView; procedure ProfileApplyExecute(Sender: TObject); procedure ProfilesBoxSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); procedure ProfilesBoxResize(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private-Deklarationen } ProfileWriter: TProfileWriter; ProfileReader: TProfileReader; public { Public-Deklarationen } end; var MainForm: TMainForm; procedure NvStartup; external 'nvcpl.dll'; implementation {$R *.dfm} procedure TMainForm.FormCreate(Sender: TObject); var F: TSearchRec; i: integer; item: TListItem; begin ProfileWriter := TProfileWriter.Create; ProfileReader := TProfileReader.Create; FindFirst(ExtractFilePath(Application.ExeName), faAnyFile, F); try repeat if LowerCase(ExtractFileExt(F.Name)) = '.DFP' then ProfileReader.ReadProfile(F.Name); until FindNext(F) <> 0; finally FindClose(F); end; with ProfileReader.Profiles do if Count > 0 then for i := 0 to Count - 1 do begin item := ProfilesBox.Items.Add; item.Caption := TProfile(Items[i]).Name; item.Data := Items[i]; end else begin Application.MessageBox('No profiles found!','Fatal Error',16); Application.Terminate; end; end; procedure TMainForm.FormDestroy(Sender: TObject); begin ProfileReader.Free; ProfileWriter.Free; end; procedure TMainForm.ProfilesBoxResize(Sender: TObject); begin ProfilesBox.Columns.Items[0].Width := ProfilesBox.ClientWidth; end; procedure TMainForm.ProfilesBoxSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); var Profile: TProfile; begin if Selected then begin Profile := Item.Data; ProfileTitleLabel.Caption := Profile.Name; ProfileDescriptionMemo.Lines.Assign(Profile.Desc); ApplyButton.Enabled := true; end else begin ProfileTitleLabel.Caption := ''; ProfileDescriptionMemo.Clear; ApplyButton.Enabled := false; end; end; procedure TMainForm.ProfileApplyExecute(Sender: TObject); begin ProfileWriter.WriteProfile(ProfilesBox.Selected.Data); end; end.
Delphi-Quellcode:
unit ProfChanger;
interface uses Registry, IniFiles, Windows, Classes, SysUtils, Dialogs; type TProfile = class public Name: string; Desc: TStringList; Settings: TStringList; constructor Create; destructor Destroy; override; end; TProfileWriter = class private Reg: TRegistry; Keys: TStringList; procedure FindKeys; public constructor Create; destructor Destroy; override; procedure WriteBinaryValue(const Name: string; var Value: array of byte); procedure WriteProfile(const Profile: TProfile); end; TProfileReader = class public Profiles: TList; procedure ReadProfile(const Filename: string); constructor Create; destructor Destroy; override; end; implementation procedure ReadREG_MULTI_SZ(const CurrentKey: HKey; const Subkey, ValueName: string; Strings: TStrings); var valueType: DWORD; valueLen: DWORD; p, buffer: PChar; key: HKEY; begin Strings.Clear; if RegOpenKeyEx(CurrentKey, PChar(Subkey), 0, KEY_READ, key) = ERROR_SUCCESS then begin SetLastError(RegQueryValueEx(key, PChar(ValueName), nil, @valueType, nil, @valueLen)); if GetLastError = ERROR_SUCCESS then if valueType = REG_MULTI_SZ then begin GetMem(buffer, valueLen); try RegQueryValueEx(key, PChar(ValueName), nil, nil, PBYTE(buffer), @valueLen); p := buffer; while p^ <> #0 do begin Strings.Add(p); Inc(p, lstrlen(p) + 1) end finally FreeMem(buffer) end end else raise ERegistryException.Create('Stringlist expected') end; end; { TProfileWriter } const ClassKey = '\Control\Class'; VideoKey = '\Control\Video'; nvKey = '\Services\nv'; constructor TProfileWriter.Create; begin inherited; Reg := TRegistry.Create; Keys := TStringList.Create; Reg.RootKey := HKEY_LOCAL_MACHINE; FindKeys; end; destructor TProfileWriter.Destroy; begin Keys.Free; Reg.Free; inherited; end; procedure TProfileWriter.FindKeys; var i,j,k: cardinal; strs1,strs2,strs3,strs4: TStringList; begin Keys.Clear; strs1 := TStringList.Create; strs2 := TStringList.Create; strs3 := TStringList.Create; strs4 := TStringList.Create; try with Reg do begin if OpenKey('\SYSTEM', false) and HasSubKeys then begin GetKeyNames(strs1); for i := 0 to strs1.Count - 1 do if OpenKey('\SYSTEM\' + strs1.Strings[i], false) and HasSubKeys and KeyExists('Control') then begin if OpenKey('\SYSTEM\' + strs1.Strings[i] + ClassKey, false) and HasSubKeys then begin GetKeyNames(strs2); for j := 0 to strs2.Count - 1 do if OpenKey('\SYSTEM\' + strs1.Strings[i] + ClassKey + '\' + strs2.Strings[j], false) and HasSubKeys then begin GetKeyNames(strs3); for k := 0 to strs3.Count - 1 do if OpenKey('\SYSTEM\' + strs1.Strings[i] + ClassKey + '\' + strs2.Strings[j] + '\' + strs3.Strings[k] + '\Settings', false) then begin ReadREG_MULTI_SZ(HKEY_LOCAL_MACHINE,CurrentPath,'InstalledDisplayDrivers',strs4); if (strs4.Count = 1) and (strs4.Strings[0] = 'nv4_disp') then Keys.Add(CurrentPath); end; end; end; if OpenKey('\SYSTEM\' + strs1.Strings[i] + VideoKey, false) and HasSubKeys then begin GetKeyNames(strs2); for j := 0 to strs2.Count - 1 do if OpenKey('\SYSTEM\' + strs1.Strings[i] + VideoKey + '\' + strs2.Strings[j], false) and HasSubKeys then begin GetKeyNames(strs3); for k := 0 to strs3.Count - 1 do if OpenKey('\SYSTEM\' + strs1.Strings[i] + VideoKey + '\' + strs2.Strings[j] + '\' + strs3.Strings[k], false) then begin ReadREG_MULTI_SZ(HKEY_LOCAL_MACHINE,CurrentPath,'InstalledDisplayDrivers',strs4); if (strs4.Count = 1) and (strs4.Strings[0] = 'nv4_disp') then Keys.Add(CurrentPath); end; end; end; if OpenKey('\SYSTEM\' + strs1.Strings[i] + nvKey, false) and HasSubKeys then begin GetKeyNames(strs2); for j := 0 to strs2.Count - 1 do if OpenKey('\SYSTEM\' + strs1.Strings[i] + nvKey + '\' + strs2.Strings[j], false) then begin ReadREG_MULTI_SZ(HKEY_LOCAL_MACHINE,CurrentPath,'InstalledDisplayDrivers',strs3); if (strs3.Count = 1) and (strs3.Strings[0] = 'nv4_disp') then Keys.Add(CurrentPath); end; end; end; end; CloseKey; end; finally strs4.Free; strs3.Free; strs2.Free; strs1.Free; end; end; procedure TProfileWriter.WriteBinaryValue(const Name: string; var Value: array of byte); var i: cardinal; begin if not assigned(keys) then begin ShowMessage('NACHRICHT'); end; if (Keys.Count > 0) and (Length(Value) > 0) then for i := 0 to Keys.Count - 1 do begin Reg.OpenKey(Keys.Strings[i], false); Reg.WriteBinaryData(Name,Value[0],Length(Value)); Reg.CloseKey; end; end; procedure TProfileWriter.WriteProfile(const Profile: TProfile); var pc: PAnsiChar; a: array of byte; i: cardinal; begin SetLength(a, 4); GetMem(pc, 5); try FillChar(pc,5,0); with Profile.Settings do begin if Count > 0 then for i := 0 to Count - 1 do begin pc := PChar(LowerCase(ValueFromIndex[i])); HexToBin(pc,pc,4); CopyMemory(@a[0],pc,4); WriteBinaryValue(Names[i],a); end; end; finally FreeMem(pc); end; end; { TProfile } constructor TProfile.Create; begin inherited; Desc := TStringList.Create; Settings := TStringList.Create; end; destructor TProfile.Destroy; begin Settings.Free; Desc.Free; inherited; end; { TProfileReader } constructor TProfileReader.Create; begin inherited; Profiles := TList.Create; ReadProfile(ExtractFilePath(ParamStr(0)) + 'Balanced.dfp'); end; destructor TProfileReader.Destroy; var i: integer; begin if Profiles.Count > 0 then for i := 0 to Profiles.Count - 1 do TProfile(Profiles.Items[i]).Free; Profiles.Free; inherited; end; procedure TProfileReader.ReadProfile(const Filename: string); var Ini: TIniFile; Prof: TProfile; strs1: TStringList; i: cardinal; s: string; begin Ini := TIniFile.Create(Filename); strs1 := TStringList.Create; with Ini do try Prof := TProfile.Create; try ReadSections(strs1); if strs1.Count = 2 then begin Prof.Name := strs1.Strings[0]; ReadSection(Prof.Name,strs1); if strs1.Count > 0 then for i := 0 to strs1.Count - 1 do Prof.Desc.Add(ReadString(Prof.Name, strs1.Strings[i], '')); ReadSection('Values',strs1); if strs1.Count > 0 then for i := 0 to strs1.Count - 1 do begin Prof.Settings.Add(strs1.Strings[i] + '=' + ReadString('Values',strs1.Strings[i],'00000000')) end else raise Exception.Create('No values in profile file "' + Filename + '"!'); Profiles.Add(Prof); end else raise Exception.Create('Invalid profile file "' + Filename + '"!'); except Prof.Free; end; finally strs1.Free; Ini.Free; end; end; end. |
Re: Seltsame Exception
Nebenbei bemerkt - die IF-Bedingung wird nie wahr:
Delphi-Quellcode:
Grüße vom marabu
repeat
if LowerCase(ExtractFileExt(F.Name)) = '.DFP' then ProfileReader.ReadProfile(F.Name); until FindNext(F) <> 0; |
Re: Seltsame Exception
Ähh.. hier stimmt was ganz gewaltig nicht.
Die IF-Bedingung sollte zwar nie wahr werden (wie du sagtest), aber sie wird IMMER wahr, egal was ich als string hinter dem = angebe. |
Re: Seltsame Exception
Wahrlich - du machst deinem nick alle Ehre...
|
Re: Seltsame Exception
Kann mir eigentlich nur vorstellen, dass ProfileApplyExecute vor dem FormCreate aufgerufen wird. Schon mal haltepunkt in Zeile 55 und 111 (nach dem Listing im Forum) gesetzt, und geschaut was zuerst aufgerufen wird?
P.S: Die IF-Bedingung kann nicht wahr werden, da du den String in klein-Buchstaben konvertierst und mit Groß-Buchstaben vergleichst ;) |
Re: Seltsame Exception
Mehr Mysterien:
Delphi-Quellcode:
Führt nur zu einer einzigen leeren ShowMessage-Box.
FindFirst(ExtractFilePath(Application.ExeName), faAnyFile, F);
try repeat showmessage(LowerCase(ExtractFileExt(F.Name))); if LowerCase(ExtractFileExt(F.Name)) = '.dfp' then ProfileReader.ReadProfile(F.Name); until FindNext(F) <> 0; finally FindClose(F); end; Im Verzeichnis ist eine einzige dfp-Datei (Balanced.dfp), die anscheinend richtig importiert wird. /edit: Ok, das lag an der Zeile:
Delphi-Quellcode:
edit/
ReadProfile(ExtractFilePath(ParamStr(0)) + 'Balanced.dfp');
Zitat:
|
Re: Seltsame Exception
Du kannst bei FindFirst auch mit Erweiterung suchen, dann sparst du dir die Abfrage:
Delphi-Quellcode:
(Kann sein, dass du vor dem Sternchen noch ein \ machen musst. Weiss jetzt nicht ob ExtractFilePath den Pfad mit oder ohne Backslash zurückgibt.
FindFirst(ExtractFilePath(Application.ExeName)+'*.dfp', faAnyFile, F);
|
Re: Seltsame Exception
Hast du dir die Demo zu FindFirst() und Co. in der Delphi Online Hilfe schon mal angesehen?
marabu |
Re: Seltsame Exception
Zitat:
Zitat:
Fehlt jetzt nur noch die AV. edit: AV weg! :-D Habe WriteProfile verändert:
Delphi-Quellcode:
procedure TProfileWriter.WriteProfile(const Profile: TProfile);
var pc: PAnsiChar; s: string; a: array of byte; i: cardinal; begin SetLength(a, 4); pc := StrAlloc(5); try with Profile.Settings do begin if Count > 0 then for i := 0 to Count - 1 do begin s := (LowerCase(ValueFromIndex[i])); HexToBin(@s[1],pc,4); CopyMemory(@a[0],pc,4); WriteBinaryValue(Names[i],a); end; end; finally StrDispose(pc); end; end; |
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:02 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz