【问题标题】:Access Violation in TDictionary<Variant, Record>TDictionary<Variant, Record> 中的访问冲突
【发布时间】:2015-04-28 22:11:08
【问题描述】:

我刚刚写了一个非常简单的类来测试Delphi XE8中的TDictionary类。

当我尝试显示我添加的记录时,它给我带来了访问冲突错误,我不明白为什么?

这是我的课

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...我总是有一个错误,我不明白为什么?

【问题讨论】:

  • 它不完全一样..他在问为什么它没有排序..并且没有递归树数据。
  • 不,Fabien,他没有问为什么它没有排序。他在问为什么他的清单没有他期望的内容。答案是 Delphi XE8 的库中有一个错误。相同的错误可能会影响您。该库也可能包含其他类似性质的错误。
  • 这严重泄漏,你仍然滥用继承。
  • 我认为这和 XE8 Insert 的 bug 不一样

标签: delphi tree associative-array tdictionary delphi-xe8


【解决方案1】:

这是一个执行的剥离版本:

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

【讨论】:

    【解决方案2】:

    您永远不会在 TREC 中创建字典,因为您永远不会在创建它的 TREC 上调用 add 函数。

    【讨论】:

    • self.items := TAArray2.create ??所以它没有创建?
    • 我在 Add 方法中添加了 showmessage,因为您可以看到它是实例化的,它显示添加了 1 个项目...
    • TREC.Add 方法不会这样做,因为除了您添加的最后一条记录外,它永远不会被调用。您必须为每个看到一条消息
    • 已添加的记录。只有 No_3 Rec 创建了 TAArray2。 TREC 的其余部分有未分配的列表。
    • 你可以检查如果 Assigned(myRec.Items) 和 myRec.Items.Count>0 那么
    猜你喜欢
    • 1970-01-01
    • 2013-03-22
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多