在使用 XE2 时，我正在为一些内存分配和异常难以定位和修复异常而苦苦挣扎。
我有一个工厂类，它创建和存储动态创建的对象以在表单上显示，但在某些情况下工厂创建失败。如果我在程序启动后执行以下代码作为第一个操作，那么一切都很好 - 内存分配得很好，所有其他功能都可以工作。但是，如果我说打开另一个表单或打开文件对话框，然后执行工厂创建，则会出现异常：
Exception EAccessViolation: Access violation at address 0040AA1F in module
'UMTester.exe'. Write of address 00000069 (OS Exception) Exception occurred at
$0040AA1F (Module "System", Procedure "@DynArrayAsg", Unit "", Line 0)
异常总是在地址 0040AA1F 并且 proc 总是@DynArrayAsg。
尽管工厂将在启动时立即创建，但我不想忽略该错误，因为那将是错误的形式！
这是工厂创建代码：
constructor TFactory.Create(FactoryObjectClass : tclass;Capacity : integer);
var nn : integer;
fptr : pointer;
fObj : TFactoryObject;
begin
fClass := FactoryObjectClass;
fsize := fclass.InstanceSize;
fdata:=nil;
//Capacity represents the number of objects; trying to allocate small amounts
//of memory results in exceptions so i artificially increase it anything less
//than 20 throws an exception
if Capacity<19 then Capacity:=20;
//This seems to reduce exceptions as the requested memory is in whole blocks
while frac((Capacity*SizeOf(Pointer))/4)<>0.0 do Inc(Capacity);
fcapacity := Capacity;
//Allocate memory
getmem(fdata,fsize*fcapacity);
getmem(fDatalist,sizeof(Pointer)*fcapacity);
getmem(ffreelist,sizeof(Pointer)*fcapacity);
fdatacount :=0;
ffreecount :=0;
fptr := fdata;
//create a pointer to the factory object at each memory address
for nn := 0 to Capacity-1 do begin
fdatalist[fdatacount]:= fptr; <------- Exception is always here
fobj := Fclass.InitInstance(fptr) as TFactoryObject;
fobj.factory := self;
fObj.Create;
fptr := pointer(integer(fptr)+fsize);
inc(fDataCount);
end;
end;
工厂指针列表是从带有标签、备忘录和列表框等基本表单元素的 TDictionary 实例化的。
procedure TObjs.Initialize(AObjs : TDict);
var
nn :integer;
C : TRttiContext;
T : TRttiInstanceType;
V : TValue;
begin
//Process all objects requested
for nn := 0 to AObjs.Count-1 do begin
//Locate the class from the supplied reference in AObjs
T := (C.GetType(TClass(FindClass(AObjs[nn]['Type']))) as TRttiInstanceType);
//Invoke the creation of the object by calling its native constructor
V := T.GetMethod('Create').Invoke(T.metaClassType,[Application]);
//Adds each requested object to the repository and displays the object
Objs[nn].SetValue(V.AsObject,AObjs[nn]);
end;
end;
观察和思考：
- 也许堆碎片意味着 fDatalist 请求的内存意味着我无法在一个连续的块中获得全部数量。
- 当创建工厂作为 pgm 启动后的第一个操作时，fDataList 始终位于地址 $1A9E2B0。如果我先显示另一个表单，则创建工厂 fDataList 的价格为 $1A9DF98。某些操作不会影响地址位置，并且当 fDataList 位于地址 $1A9E2B0 时不会引发异常。我没有将 fDataList 分配给特定地址，所以天知道为什么它在这个地址而不是其他地址工作。
- 在“如果容量<19 则容量：=20；”这一行上 如果我将 20 更改为 60，我可以将异常推迟更长时间，即我可以在创建工厂之前执行更多数量的不相关程序。尽管在一定数量的使用后总是会发生异常。
工厂在这里创建一次：
SetLength(Objs,AObjs.Count);
AFactory := TFactory.Create(TchObj,AObjs.Count);
//Initialize the full array of objects
for Index := 0 to AObjs.Count -1 do
Objs[Index] := Afactory.Request_obj as TchObj;
TFactory 的类定义是：
TchFactory = class
private
fdata : pointer;
fsize : integer;
fDataList : PPointerList; // from classes unit
fdatacount : integer;
fFreeList : PPointerList;
fFreeCount : integer;
fCapacity : integer;
fcLass : TClass;
public
constructor Create(FactoryObjectClass : Tclass;Capacity : integer);
destructor Destroy; override;
function Request_Obj : TchFactoryObject;
procedure Recycle(FactoryObject : TchFactoryObject);
property Capacity : integer read fCapacity;
property CountUsed : integer read fdataCount;
property CountFree : integer read fFreeCount;
end;
我可以看什么？
关于我如何调试的任何想法？
还是我只是在做一些非常错误的事情？
编辑： 删除 David 所指的“试验和错误”行并将 GetMem 更改为 AllocMem 可以解决问题。所以工厂构造函数的最终代码是：
constructor TchFactory.Create(FactoryObjectClass : tclass;Capacity : integer);
var Index : integer;
fptr : pointer;
fObj : TchFactoryObject;
begin
fClass := FactoryObjectClass;
fsize := fclass.InstanceSize;
fcapacity := Capacity;
fdata := AllocMem(fsize*fcapacity);
fdatalist:= AllocMem(sizeof(Pointer)*fcapacity);
fFreelist:= AllocMem(sizeof(Pointer)*fcapacity);
fdatacount :=0;
ffreecount :=0;
fptr := fdata;
for index := 0 to Capacity-1 do begin
fdatalist[fdatacount]:= fptr;
fobj := Fclass.InitInstance(fptr) as TchFactoryObject;
fobj.factory := self;
fObj.Create;
fptr := pointer(integer(fptr)+fsize);
inc(fDataCount);
end;
end;