Unerklärliche EAccessViolation -> Meldung Invalid Pointer Operation

[FragenderHerbert]

Hallo,

ich habe gerade einen Dialog in Arbeit, aus dem ich später vorher registrierte Tools auswählen will. Jedoch erhalte ich die im Titel genannte Exception, die ich mir nicht erklären kann.

Es geht um einen Auswahldialog, aus dem ich ein vorher registriertes Kommandozeilentool als aktuell aktives auswählen will. Doch dieser Dialog wirft die genannte Exception bei AssignCommands im Hauptprogramm:

Delphi-Quellcode:

procedure TMainForm.menuActiveToolClick(Sender: TObject);
var
  CurrentTool: Integer;
begin
  if Assigned(CmdLines) and (CmdLines.Count > 0) then
  begin
    if Assigned(DlgChooseCommandTool) then
      DlgChooseCommandTool.AssignCommands(CmdLines); //Hier kommt die Exception
    DlgChooseCommandTool.ShowModal;
    if DlgChooseCommandTool.ModalResult = mrOk then
    begin
      CurrentTool := DlgChooseCommandTool.ChoosedIndex;
      ShowMessage('Index Of Current Tool is: '+IntToStr(CurrentTool));
    end;
  end
  else ShowMessage('Bitte registrieren Sie zuerst ein Tool im Menü [Tool registrieren...]!');
end;

Der Delphi Debugger springt in diese Systemroutine -> _LStrArrayClr(var StrArray; cnt: longint) an diese Stelle:

Delphi-Quellcode:

        CALL    _FreeMem
@@doneEntry:

Hier ist der Auswahldialog:

Delphi-Quellcode:

unit UDlgChooseCommandTool;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, UCommandInterface, UCmdTools;

type
  TCommands = class(TInterfacedObject, ICommandTool)
  private
    FCommands: TCmdTools;
  public
    constructor Create;
    destructor Destroy; override;

    function GetCommand(Index: Integer): TCmdTool;
    function GetCount: Integer;


    procedure AssignCommands(Commands: TCmdTools);
    procedure RegisterCommand(
      Name, Command: String; Options:String=''; CfgFile:String=''; AOptionsFactory:TOptionsFactory=nil
    );
    procedure SetCommand(Index: Integer; Value: TCmdTool);

    property Command[Index: Integer]: TCmdTool read GetCommand;
    property Count: Integer read GetCount;
  end;

  TDlgChooseCommandTool = class(TForm)
    lbxChoosedCommandTool: TListBox;
    cbxChoosedCommandTool: TComboBox;
    lbRegisteredCommandTools: TLabel;
    lbChoosedCommandTool: TLabel;
    btnOk: TButton;
    btnCancel: TButton;
    btnHelp: TButton;
    procedure FormCreate(Sender: TObject);
    procedure lbxChoosedCommandToolClick(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FCommands: TCommands;
    FCurrentChoosed: Integer;
    //FOptionsFactory: TComponent;
    function GetChoosedIndex: Integer;
  public
    { Public declarations }
    procedure AssignCommands(Commands: TCmdTools);
    property ChoosedIndex: Integer read GetChoosedIndex;
  end;

var
  DlgChooseCommandTool: TDlgChooseCommandTool;


implementation

{$R *.dfm}

procedure TDlgChooseCommandTool.AssignCommands(Commands: TCmdTools);
var Index: Integer;
begin
  if (Assigned(Commands)) and (Assigned(FCommands)) then
  begin
    FCommands.AssignCommands(Commands);
    for Index := 0 to Commands.Count - 1 do
    begin
      cbxChoosedCommandTool.Items.Add(FCommands.Command[Index].Name);
      lbxChoosedCommandTool.Items.Add(FCommands.Command[Index].Name);
    end;
  end; 
end;

procedure TDlgChooseCommandTool.btnOkClick(Sender: TObject);
begin
  GetChoosedIndex;
end;

procedure TDlgChooseCommandTool.FormCreate(Sender: TObject);
begin
  FCommands := TCommands.Create;
end;

procedure TDlgChooseCommandTool.FormDestroy(Sender: TObject);
begin
  if Assigned(FCommands) then begin FCommands.Free; FCommands := nil; end;
end;

function TDlgChooseCommandTool.GetChoosedIndex: Integer;
var Index: Integer;
begin
  Result := -1;
  while Index < lbxChoosedCommandTool.Items.Count do
  begin
    if cbxChoosedCommandTool.Items[Index] = cbxChoosedCommandTool.Text then
    begin
      FCurrentChoosed := Index;
      Result := Index;
      Index := lbxChoosedCommandTool.Items.Count;
    end;
    Inc(Index);
  end;
end;

procedure TDlgChooseCommandTool.lbxChoosedCommandToolClick(Sender: TObject);
begin
  cbxChoosedCommandTool.ItemIndex := lbxChoosedCommandTool.ItemIndex;
  cbxChoosedCommandTool.Text := cbxChoosedCommandTool.Items[cbxChoosedCommandTool.ItemIndex];
end;

{ TCommands }

procedure TCommands.AssignCommands(Commands: TCmdTools);
begin
  if Assigned(Commands) then FCommands.Assign(Commands);
end;

constructor TCommands.Create;
begin
  inherited Create;
  FCommands := TCmdTools.Create;
end;

destructor TCommands.Destroy;
begin
  FCommands.Free;
  inherited;
end;

function TCommands.GetCommand(Index: Integer): TCmdTool;
begin
  if Assigned(FCommands) then
   Result := TCmdTool(FCommands[Index])
  else Result := nil;
end;

function TCommands.GetCount: Integer;
begin
  Result := FCommands.Count;
end;

procedure TCommands.RegisterCommand(Name, Command, Options, CfgFile: String;
  AOptionsFactory: TOptionsFactory);
begin
  FCommands.AddCmdTool(RegisterCommandLineTool(Name, Command, Options, CfgFile, AOptionsFactory));
end;

procedure TCommands.SetCommand(Index: Integer; Value: TCmdTool);
begin
  {
  FCommands.CmdTool[Index].Name := Value.Name;
  FCommands.CmdTool[Index].Command := Value.Command;
  FCommands.CmdTool[Index].CfgFile := Value.CfgFile;
  }
  FCommands.CmdTool[Index].Factory := Value.Factory;
end;


end.

Diese Unit stellt mein Kommandotoolinterface bereit:

Delphi-Quellcode:

unit UCmdTools;

interface

uses
  Classes, Contnrs, IniFiles;

type
  //Platzhalter für späteren Optionsdialog
  //zur interaktiven Einstellung der Kom-
  //mandozeilenparameter des aktuell ausge-
  //wählten Tools
  TOptionsFactory = TComponent;

  //ein Kommandozeilentool
  TCmdTool = class(TObject)
  private
    FCfgFile: String;
    FCommand: String;
    FName: String;
    FOptions: String;
    FOptionsFactory: TOptionsFactory;
    function GetOptionsFactory: TOptionsFactory;
    procedure SetOptionsFactory(const Value: TOptionsFactory);
  public
    procedure ApplyOptions; virtual; abstract;
    constructor Create(aName,aCommand: String; aOptions:String=''; aCfgFile:String='');
    destructor Destroy; override;
    function CfgFile: String; //cfg Datei für Kommandozeilenparameter
    function Command: String; //exename + Optionen
    function Name: String;    //Name im Menü
    property Factory: TOptionsFactory read GetOptionsFactory write SetOptionsFactory;
  end;

  //Liste aller registrierten Tools
  TCmdTools = class(TObjectList)
    function GetCmdTool(Index: Integer): TCmdTool;
    function AddCmdTool(CmdTool: TCmdTool): Integer;
    property CmdTool[Index: Integer]: TCmdTool read GetCmdTool;
  end;

var
  CmdLines: TCmdTools;

//Diese Funktion soll ein Tool registrieren (in die Liste schreiben)
function RegisterCommandLineTool(Name, Command: String; Options:String=''; CfgFile:String=''; AOptionsFactory:TOptionsFactory=nil): TCmdTool;

implementation

function RegisterCommandLineTool(Name, Command: String; Options:String=''; CfgFile:String=''; AOptionsFactory:TOptionsFactory=nil): TCmdTool;
var CmdTool: TCmdTool;
begin
  try
    CmdTool := TCmdTool.Create(Name, Command, Options, CfgFile);
    CmdTool.Factory := AOptionsFactory;
    CmdLines.AddCmdTool(CmdTool)
  finally
    Result := CmdTool;
    CmdTool.Free;
  end;
end;

{ TCmdTools }

function TCmdTools.AddCmdTool(CmdTool: TCmdTool): Integer;
begin
  Result := Add(CmdTool);
end;

function TCmdTools.GetCmdTool(Index: Integer): TCmdTool;
begin
  Result := TCmdTool(Items[Index])
end;

{ TCmdTool }

function MakeOptFile(AOptions: String): String;
var f: file; opts: array[0..127] of char; w:longint;
begin
  fillchar(opts, Sizeof(opts), ' ');
  move(AOptions[1], opts, Sizeof(opts));
  Assign(f, 'extrafpc.cfg');
  Rewrite(f);
  blockwrite(f, opts, Sizeof(opts), w);
  Close(f);
  MakeOptFile := '@extrafpc.cfg';
end;

function TCmdTool.CfgFile: String;
begin
  Result := FCfgFile;
end;

function TCmdTool.Command: String;
begin
  if FCommand <> '' then
  if FOptions <> '' then
    Result := FCommand + ' ' + FCfgFile + ' ' + FOptions;
end;

constructor TCmdTool.Create(aName,aCommand: String; aOptions:String=''; aCfgFile:String='');
begin
  FCfgFile := CfgFile;
  FOptions := FOptions;
  FCommand := Command;
  FName    := Name;
end;

destructor TCmdTool.Destroy;
begin
  if Assigned(FOptionsFactory) then
  begin
    FOptionsFactory.Free;
    FOptionsFactory := nil;
  end;
  inherited;
end;

function TCmdTool.GetOptionsFactory: TOptionsFactory;
begin
  Result := FOptionsFactory;
end;

function TCmdTool.Name: String;
begin
  Result := FName;
end;

procedure TCmdTool.SetOptionsFactory(const Value: TOptionsFactory);
begin
  if FOptionsFactory <> Value then
  begin
    if Assigned(FOptionsFactory) then
    begin
      FOptionsFactory.Free;
      FOptionsFactory := nil;
    end;
    FOptionsFactory := Value;
  end;
end;

initialization
  CmdLines := TCmdTools.Create;

finalization
  CmdLines.Free;

end.