Нарушение прав доступа в TDictionary<Variant, Record>

Я только что написал очень простой класс для тестирования класса TDictionary<> в Delphi XE8.

Когда я пытаюсь показать записи, которые я добавил, это вызывает ошибку Access Violation, я не понимаю, почему?

Вот мой класс

unit Unit3;

interface

 uses
  Classes, System.SysUtils, System.Types, REST.Types, System.JSON, Data.Bind.Components,
  System.RegularExpressions, System.Variants,
  Generics.Collections, FMX.Dialogs {$IFDEF DEBUG}, CodeSiteLogging{$ENDIF};

type

  TAArray2 = class;

  PTRec=^TRec;

  TRec = class
  public
    Key : Variant;
    isRequired : boolean;
    Value : Variant;
    OldValue : Variant;
    JSON : string;
    Items : TAArray2;
    procedure Add(Key : Variant ; Value: TRec);
  end;

   TAArray2 = class(TDictionary<Variant, TRec>)
   private
     function Get(Index: variant): TRec;
   public
     destructor Destroy; override;
     procedure Add(Key : Variant ; Value: TRec);
     property Items[Cle : Variant]: TRec read Get; default;
   end;

implementation

procedure TRec.Add(Key : Variant ; Value: TRec);
begin
  if not(assigned(items)) then
    self.Items := TAArray2.Create;
  Items.Add( Key, Value);
  showmessage(inttostr(items.Count)); // this show 1 means items is instanciate and contain the proper data
end;

function TAArray2.Get(Index: Variant): TRec;
begin
  Result := inherited items[Index]
end;

end.

Затем я использую этот код для проверки: (форма с 1 TButton и 1 TMemo)

procedure TForm1.ShowAssocArray2(AAA : TAArray2 ; Level : integer);
var
  s : string;
  MyRec : TRec;
begin
  for MyRec in AAA.Values Do
  begin
    FillChar(s, Level * 4, ' ');
    memo1.Lines.Add(s + string(MyRec.Key) + ' = ' + string(MyRec.Value));
    if MyRec.Items.Count > 0 then  // ERROR HERE
      ShowAssocArray2(MyRec.items, Level + 1);   // recursive for childrens
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  MyList : TAArray2;
  MyRec : TRec;
  i : Integer;
begin
  MyList := TAArray2.Create;
  for i := 0 to 9 do
  begin
    MyRec := TRec.Create;
    MyRec.Value := 'Value_' + inttostr(i);
    MyRec.Key := 'No_' + inttostr(i);
    MyList.Add(MyRec.Key, MyRec);
  end;
  // subitem
  MyRec := TRec.Create;
  MyRec.Value := 'test' + inttostr(i);
  MyRec.Key := 'test' + inttostr(i);
  MyList.Items['No_3'].Add('Extra', MyRec);

  memo1.Lines.Add('Nb of Record : ' + inttostr(MyList.Count));

  ShowAssocArray2(MyList, 0);

end;

Я пробовал много способов: MyRec.Items.Count или MyRec.Values.Count или MyRec.Items.Values.count... У меня всегда есть ошибка, я не понимаю, почему?

2 ответа

Решение

Это урезанная версия, которая выполняет:

program Project20;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,Generics.Collections,StrUtils;


type
  TAArray2 = class;

  TRec = class
  public
    Key : Variant;
    Value : Variant;
    Items : TAArray2;
    procedure Add(Key : Variant ; Value: TRec);
  end;

   TAArray2 = class(TDictionary<Variant, TRec>)
   private
     function Get(Index: variant): TRec;
   public
     destructor Destroy; override;
     //procedure Add(Key : Variant ; Value: TRec);
     property Items[Cle : Variant]: TRec read Get; default;
   end;

procedure TRec.Add(Key : Variant ; Value: TRec);
begin
  if not(assigned(items)) then
    self.Items := TAArray2.Create;
  Items.Add( Key, Value);
  WriteLn(inttostr(items.Count)); // this show 1 means items is instanciate and contain the proper data
end;

destructor TAArray2.Destroy;
begin

  inherited;
end;

function TAArray2.Get(Index: Variant): TRec;
begin
  Result := inherited items[Index]
end;

procedure ShowAssocArray2(AAA : TAArray2 ; Level : integer);
var
  s : string;
  MyRec : TRec;
begin
  s := DupeString(' ',Level * 4);
  for MyRec in AAA.Values Do
  begin
    WriteLn(s + string(MyRec.Key) + ' = ' + string(MyRec.Value));
    if Assigned(MyRec.Items) then // <-- Test if Items is assigned
     if MyRec.Items.Count > 0 then 
      ShowAssocArray2(MyRec.items, Level + 1);   // recursive for childrens
  end;
end;

var
  MyList : TAArray2;
  MyRec : TRec;
  i : Integer;
begin
  MyList := TAArray2.Create;
  for i := 0 to 9 do
  begin
    MyRec := TRec.Create;
    MyRec.Value := 'Value_' + inttostr(i);
    MyRec.Key := 'No_' + inttostr(i);
    MyList.Add(MyRec.Key, MyRec);
  end;
  // subitem
  MyRec := TRec.Create;
  MyRec.Value := 'test' + inttostr(i);
  MyRec.Key := 'test' + inttostr(i);
  MyList.Items['No_3'].Add('Extra', MyRec);

  WriteLn('Nb of Record : ' + inttostr(MyList.Count));

  ShowAssocArray2(MyList, 0);
  ReadLn;
end.

Призыв к FillChar() был заменен на DupeString(), так как память не была выделена для строки до FillChar(),

Есть также тест для Assigned(MyRec.Items) Это разрешает случай, когда Предметы не назначены, что стало причиной нарушения вашего доступа.

Это выполняется, но я не проанализировал, если результат того, что вы хотите. Не забудьте также убедиться в отсутствии утечек памяти.

Распечатка:

1
Nb of Record : 10
No_4 = Value_4
No_3 = Value_3
    test10 = test10
No_9 = Value_9
No_7 = Value_7
No_8 = Value_8
No_1 = Value_1
No_2 = Value_2
No_5 = Value_5
No_0 = Value_0
No_6 = Value_6

Вы никогда не создаете словарь в TREC, потому что вы никогда не вызываете функцию добавления в TREC, которая его создает.

Другие вопросы по тегам