TDictionary<Variant, Record> 中的访问冲突
Access Violation in TDictionary<Variant, Record>
我刚刚写了一个非常简单的 class 来测试 Delphi XE8 中的 TDictionary<> Class。
当我尝试显示我添加的记录时,它给我带来了访问冲突错误,我不明白为什么?
这是我的 class
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...我总是出错,我不明白为什么?
您永远不会在 TREC 中创建字典,因为您永远不会在创建它的 TREC 上调用添加函数。
这是执行的剥离版本:
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
我刚刚写了一个非常简单的 class 来测试 Delphi XE8 中的 TDictionary<> Class。
当我尝试显示我添加的记录时,它给我带来了访问冲突错误,我不明白为什么?
这是我的 class
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...我总是出错,我不明白为什么?
您永远不会在 TREC 中创建字典,因为您永远不会在创建它的 TREC 上调用添加函数。
这是执行的剥离版本:
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