Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi Seltsame Exception (https://www.delphipraxis.net/56167-seltsame-exception.html)

Mystic 1. Nov 2005 19:42


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:
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;
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:

Delphi-Quellcode:
if (Keys.Count > 0) and (Length(Value) > 0) then
Zitat:

Im Projekt DNAProfChanger.exe ist eine Exception der Klasse EAccessViolation mit der Meldung 'Zugriffsverletzung bei Adresse 0047122B in Modul 'DNAProfChanger.exe'. Lesen von Adresse 00000000' aufgetreten.
gefolgt von einer "Ungültigen Zeigeroperation".

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!? :?

Luckie 1. Nov 2005 19:46

Re: Seltsame Exception
 
Erzeugst du auch eine Instanz der Klasse?

Mystic 1. Nov 2005 19:51

Re: Seltsame Exception
 
Ja.

Delphi-Quellcode:
procedure TMainForm.FormCreate(Sender: TObject);
var
  F: TSearchRec;
  i: integer;
  item: TListItem;
begin
  ProfileWriter := TProfileWriter.Create;

Luckie 1. Nov 2005 19:53

Re: Seltsame Exception
 
Und wo wird die private variable Keys gefüllt?

Mystic 1. Nov 2005 19:56

Re: Seltsame Exception
 
Keys wird im Konstruktor von TProfileWriter erstellt.

Delphi-Quellcode:
constructor TProfileWriter.Create;
begin
  inherited;
  Reg := TRegistry.Create;
  Keys := TStringList.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;

  FindKeys;
end;
FindKeys füllt die Stringliste Keys mit Einträgen.

Der_Unwissende 1. Nov 2005 20:22

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:
if not assigned(keys) then
  begin
    ShowMessage('NACHRICHT');
  end;
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
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

Mystic 1. Nov 2005 20:26

Re: Seltsame Exception
 
Zitat:

Zitat von Der_Unwissende
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:
if not assigned(keys) then
  begin
    ShowMessage('NACHRICHT');
  end;
vor die Zeile mit dem Fehler (mag überflüssig erscheinen, aber so kann man halt leicht auf Nummer sicher gehen!),

Hab ich schon probiert. Keys = nil.

Zitat:

Zitat von Der_Unwissende
ok, Debugger und den Wert von Keys tuts natürlich auch. Und wenn der sicher nil / 0 ist, dann muss
a) die Zeile Keys = TStringList.Create nie aufgerufen werden oder

Seltsamerweise klappt es ja, wenn ich WriteBinaryValue im OnCreate von MainForm (nach dem TProfileWriter.Create) aufrufe.

Zitat:

Zitat von Der_Unwissende
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

Keys wird nur im Destruktor von TProfileWriter freigegeben.

Zitat:

Zitat von Der_Unwissende
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).

Die Aktion wird durch einen Buttonklick von mir ausgelöst, daher dürfte das wegfallen.

----

Seltsam. Mache ich die Methoden virtuell, tritt der Fehler schon hier auf:

Delphi-Quellcode:
WriteBinaryValue(Names[i],a);

Der_Unwissende 1. Nov 2005 20:32

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:

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:

jim_raynor 1. Nov 2005 20:33

Re: Seltsame Exception
 
Solangsam deutet alles darauf hin, dass du doch nicht korrekt eine Instanz von TProfileWrite erzeugst.

Mystic 1. Nov 2005 20:38

Re: Seltsame Exception
 
Zitat:

Zitat von Der_Unwissende
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

Welches OnActionExecute-Event?

Ich rufe es im OnExecute der Aktion auf.

Zitat:

Zitat von jim_raynor
Solangsam deutet alles darauf hin, dass du doch nicht korrekt eine Instanz von TProfileWrite erzeugst.

Wie gesagt, wenn ich WriteBinaryValue aus dem OnCreate des Hauptformulars aufrufe, funktioniert alles.

Wenn ich WriteProfile im OnCreate aufrufe, kommt wieder der gleiche Mist.

Ich denke der Fehler ist im WriteProfile.

Der_Unwissende 1. Nov 2005 20:50

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.

Mystic 1. Nov 2005 20:55

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.

marabu 1. Nov 2005 21:00

Re: Seltsame Exception
 
Nebenbei bemerkt - die IF-Bedingung wird nie wahr:

Delphi-Quellcode:
repeat
  if LowerCase(ExtractFileExt(F.Name)) = '.DFP' then
    ProfileReader.ReadProfile(F.Name);
until FindNext(F) <> 0;
Grüße vom marabu

Mystic 1. Nov 2005 21:04

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.

marabu 1. Nov 2005 21:06

Re: Seltsame Exception
 
Wahrlich - du machst deinem nick alle Ehre...

jim_raynor 1. Nov 2005 21:06

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 ;)

Mystic 1. Nov 2005 21:10

Re: Seltsame Exception
 
Mehr Mysterien:

Delphi-Quellcode:
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;
Führt nur zu einer einzigen leeren ShowMessage-Box.

Im Verzeichnis ist eine einzige dfp-Datei (Balanced.dfp), die anscheinend richtig importiert wird.

/edit:

Ok, das lag an der Zeile:

Delphi-Quellcode:
ReadProfile(ExtractFilePath(ParamStr(0)) + 'Balanced.dfp');
edit/

Zitat:

Zitat von jim_raynor
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 ;)

Das Create wird zuerst aufgerufen.

jim_raynor 1. Nov 2005 21:15

Re: Seltsame Exception
 
Du kannst bei FindFirst auch mit Erweiterung suchen, dann sparst du dir die Abfrage:

Delphi-Quellcode:
FindFirst(ExtractFilePath(Application.ExeName)+'*.dfp', faAnyFile, F);
(Kann sein, dass du vor dem Sternchen noch ein \ machen musst. Weiss jetzt nicht ob ExtractFilePath den Pfad mit oder ohne Backslash zurückgibt.

marabu 1. Nov 2005 21:16

Re: Seltsame Exception
 
Hast du dir die Demo zu FindFirst() und Co. in der Delphi Online Hilfe schon mal angesehen?

marabu

Mystic 1. Nov 2005 21:19

Re: Seltsame Exception
 
Zitat:

Zitat von marabu
Hast du dir die Demo zu FindFirst() und Co. in der Delphi Online Hilfe schon mal angesehen?

marabu

Hab ich, und jetzt funktioniert der Find*-Teil auch.

Zitat:

Zitat von jim_raynor
Du kannst bei FindFirst auch mit Erweiterung suchen, dann sparst du dir die Abfrage:

Delphi-Quellcode:
FindFirst(ExtractFilePath(Application.ExeName)+'*.dfp', faAnyFile, F);
(Kann sein, dass du vor dem Sternchen noch ein \ machen musst. Weiss jetzt nicht ob ExtractFilePath den Pfad mit oder ohne Backslash zurückgibt.

Hab ich gerade auf die gleiche Weise gelöst. ;)

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