function TMemoryManager.GetInstanceSize:Cardinal;
begin
Result:=self.FList.InstanceSize;
end;
function TMemoryManager.FGetSize(addr:Pointer):Integer;
var i:integer;
begin
i:=Find(Addr);
Result:=-1;
if i=-1 then exit;
Result:=PMemBlock(FList[i]).Size ;
end;
procedure TMemoryManager.DisposeLocal;
var i:integer;
begin
for i:=0 to FList.Count -1 do
MemoryCollector.Unlog(PMemBlock(FList[i])^.Ptr);
FList.Clear ;
end;
constructor TMemoryManager.Create;
begin
FList:=TList.Create ;
MemoryCollector.FConnections.Add(Self);
MemoryCollector.FInstances.Add(self);
end;
destructor TMemoryManager.Free;
begin
DisposeLocal;
MemoryCollector.RemoveInstance(self);
MemoryCollector.FConnections.Remove(self);
FList.Free ;
end;
function TMemoryManager.FAllocateMemory(dwSize:Cardinal):Pointer;
var tmp:PMemBlock;
begin
lxcAssertThrow(dwSize>0,EErrorSize,LS_E_SIZE);
Result:=Allocate(dwSize);
//log globally
MemoryCollector.Log(Result,dwSize,DisposeCallback);
//log locally
GetMem(tmp,sizeof(TMemBlock));
tmp^.ReleaseFunc :=nil;
tmp^.Ptr :=Result;
tmp^.Size :=dwSize;
FList.Add(tmp);
end;
function TMemoryManager.Allocate(dwSize:Cardinal):Pointer;
begin
GetMem(Result,dwSize);
end;
function TMemoryManager.Find(Ptr:Pointer):Integer;
var i:integer;
begin
Result:=-1;
for i:=0 to FList.Count -1 do
if PMemBlock(FList[i]).Ptr=Ptr then
begin
Result:=i;
end;
end;
procedure TMemoryManager.FReleaseMemory(dwSize:Cardinal;Ptr:Pointer);
var i:integer;
begin
lxcAssertThrow(Assigned(Ptr),ENullMem,LS_E_NULL_RELEASE);
i:=Find(Ptr);
lxcAssertThrow(i>-1,EBadMem,LS_E_BAD_MEMORY);
//unlog it globally
MemoryCollector.Unlog(Ptr);
//Unlog it locally
FreeMem(FList[i]);
FList.Delete(i);
end;
procedure TMemoryManager.Dispose(dwSize:Cardinal;Ptr:Pointer);
begin
try
FreeMem(Ptr);
except
end;
end;
procedure TMemoryManager.DisposeCallback(dwSize:Cardinal;Ptr:Pointer);
begin
lxcAssertThrow(Assigned(Ptr),ENullMem,LS_E_NULL_RELEASE);
self.Dispose(dwSize,Ptr);
end;
function TMemoryManager.FGetBaseAddress(Addr:Pointer):Pointer;
var i:integer;lower,upper,addr2:cardinal;
begin
Result:=nil;
addr2:=Cardinal(addr);
for i:=0 to FList.Count -1 do
begin
lower:=Cardinal(PMemBlock(FList[i])^.Ptr) ;
upper:=lower+PMemBlock(FList[i])^.Size ;
if (addr2>=lower) and (addr2<upper) then
begin
Result:=PMemBlock(FList[i])^.Ptr;
Exit;
end;
end;
end;
/////////////////////////////////////////////////////
//
/////////////////////////////////////////////////////
function TExecMemManager.Allocate(dwSize:Cardinal):Pointer;
begin
Result:=VirtualAlloc(nil,dwSize,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
end;
procedure TExecMemManager.Dispose(dwSize:Cardinal;Ptr:Pointer);
begin
VirtualFree(ptr,dwSize,MEM_RELEASE);
end;
/////////////////////////////////////////////////////
//
/////////////////////////////////////////////////////
function TFixedMemManager.Allocate(dwSize:Cardinal):Pointer;
begin
Result:=Pointer(GlobalAlloc(GMEM_FIXED or GMEM_ZEROINIT,dwSize));
end;
procedure TFixedMemManager.Dispose(dwSize:Cardinal;Ptr:Pointer);
begin
lxcAssertThrow(Cardinal(GlobalFree(Ptr))=0,EReleaseFailure,LS_E_RELEASE_FAILURE);
end;
initialization
MemoryCollector:=TMemoryCollector.Create ;
finalization
MemoryCollector.Free ;
end.
function TMemoryCollector.AddInstance(AInstance:TObject):Integer;
begin
Result:=FInstances.Add(AInstance)
end;
procedure TMemoryCollector.DeleteInstance(AIndex:integer);
begin
FInstances.Delete(AIndex)
end;
procedure TMemoryCollector.RemoveInstance(AInstance:TObject);
begin
FInstances.Remove(AInstance);
end;
function TMemoryCollector.FGetInstances(AIndex:Integer):TObject;
begin
Result:=TObject(FInstances[AIndex]);
end;
function TMemoryCollector.FGetInstanceCount:Cardinal;
begin
Result:=FInstances.Count;
end;
function TMemoryCollector.GetInstanceSize:Cardinal;
begin
Result:=self.FList.InstanceSize +self.FConnections.InstanceSize +self.FInstances.InstanceSize;
end;
function TMemoryCollector.FGetInstanceSize:Cardinal;
var i:integer;_size:cardinal;
begin
_size:=0;
for i:=0 to self.FInstances.Count -1 do
_size:= _size+TDynamicCoderbase(FInstances[i]).GetInstanceSize+ Cardinal(TDynamicCoderbase(FInstances[i]).InstanceSize) ;
result:=_size;
end;
function TMemoryCollector.FGetConnections:Cardinal;
begin
Result:=FConnections.Count ;
end;
function TMemoryCollector.FGetSize(Ptr:Pointer):Integer;
var i:integer;
begin
Result:=-1;
i:=Find(Ptr);
if i=-1 then exit;
Result:=PMemBlock(FList[i]).Size;
end;
function TMemoryCollector.FGetCount:integer;
begin
Result:=FList.Count ;
end;
function TMemoryCollector.FGetSizes:Integer;
var i:integer;
begin
Result:=0;
for i:=0 to FList.Count -1 do
Inc(Result,PMemBlock(FList[i])^.Size);
end;
function TMemoryCollector.Find(Ptr:Pointer):integer;
var i:integer;
begin
Result:=-1;
for i:=0 to FList.Count -1 do
if PMemblock(FList[i])^.Ptr =Ptr then
begin
Result:=i;
exit;
end;
end;
procedure TMemoryCollector.Log(Ptr:Pointer;dwSize:Cardinal;ReleaseFunc:TReleaseFunc);
var MemBlock:PMemBlock;
begin
lxcAssertThrow(Assigned(Ptr),ENullMem,LS_E_NULL_LOG);
GetMem(MemBlock,sizeof(TMemBlock));
MemBlock^.ReleaseFunc :=ReleaseFunc;
MemBlock^.Size:=dwSize;
MemBlock^.Ptr :=Ptr;
FList.Add(MemBlock);
end;
procedure TMemoryCollector.Unlog(Ptr:Pointer);
var i:integer;tmp:PMemBlock;
begin
i:=Find(Ptr);
lxcAssertThrow(i>-1,EBadMem,LS_E_BAD_MEMORY);
tmp:=PMemBlock(FList[i]);
tmp^.ReleaseFunc(tmp.Size,tmp.Ptr);
FreeMem(tmp);
FList.Delete(i);
end;
procedure TMemoryCollector.Remove(Ptr:Pointer);
var i:integer;
begin
i:=Find(Ptr);
lxcAssertThrow(i>-1,EBadMem,LS_E_BAD_MEMORY);
FList.Delete(i);
end;
constructor TMemoryCollector.Create;
begin
FList:=TList.Create ;
FConnections:=TList.Create;
FInstances:=TList.Create ;
inherited;
end;
destructor TMemoryCollector.Free;
begin
DisposeAll;
FConnections.Free ;
FList.Free ;
FInstances.Free ;
end;
procedure TMemoryCollector.DisposeAll ;
var i:integer;tmp:PMemBlock;
begin
for i:=0 to FConnections.Count -1 do
TMemoryManager(FConnections[i]).DisposeLocal;
exit;
for i:=0 to FList.Count -1 do
begin
tmp:=PMemBlock(FList[i]);
tmp.ReleaseFunc(tmp^.Size,tmp^.Ptr);
FreeMem(tmp);
end;
FList.Clear ;
end;
我的DC库中有个内存管理的类,有个是申请固定线性地址,估计对你有用:
unit lxcMemoryManager;
interface
uses Windows, Messages, SysUtils, Variants, Classes,
lxcGlobal, lxcExceptions,lxcStrings,lxcDynamicCoder;
type
TReleaseFunc=procedure(dwSize:Cardinal;Ptr:Pointer) of object;
PMemBlock=^TMemBlock;
TMemBlock=record
ReleaseFunc:TReleaseFunc;
Ptr:Pointer;
Size:Cardinal;
end;
TMemoryManager=class;
TMemoryCollector=class(TDynamicCoderBase)
private
FList:TList;
FConnections:TList;
FInstances:TList;
function Find(Ptr:Pointer):integer;
function FGetSize(Ptr:Pointer):Integer;
function FGetCount:integer;
function FGetSizes:Integer;
function FGetConnections:Cardinal;
function FGetInstances(AIndex:Integer):TObject;
function FGetInstanceCount:Cardinal;
function FGetInstanceSize:Cardinal;
public
property Size[Ptr:Pointer]:Integer read FGetSize;
property Count:Integer read FGetCount;
property Connections:Cardinal read FGetConnections;
property Sizes:Integer read FGetSizes;
property Instances[AIndex:integer]:TObject read FGetInstances;
property InstanceCount:Cardinal read FGetInstanceCount;
property InstanceSizes:Cardinal read FGetInstanceSize;
function GetInstanceSize:Cardinal;override;
function AddInstance(AInstance:TObject):Integer;
procedure DeleteInstance(AIndex:integer);
procedure RemoveInstance(AInstance:TObject);
procedure Log(Ptr:Pointer;dwSize:Cardinal;ReleaseFunc:TReleaseFunc);
procedure Unlog(Ptr:Pointer);
procedure Remove(Ptr:Pointer);
procedure DisposeAll;
constructor Create;
destructor Free;
end;
TMemoryManager=class(TDynamicCoderBase)
private
FList:TList;
function FAllocateMemory(dwSize:Cardinal):Pointer;
procedure FReleaseMemory(dwSize:Cardinal;Ptr:Pointer);
procedure DisposeCallback(dwSize:Cardinal;Ptr:Pointer);
function Allocate(dwSize:Cardinal):Pointer;virtual;
procedure Dispose(dwSize:Cardinal;Ptr:Pointer);virtual;
function FGetSize(addr:Pointer):Integer;
function Find(Ptr:Pointer):Integer;
function FGetBaseAddress(Addr:Pointer):Pointer;
public
constructor Create;
destructor Free;
function GetInstanceSize:Cardinal;override;
procedure DisposeLocal;
property Memory[dwSize:Cardinal]:Pointer read FAllocateMemory write FReleaseMemory;default;
property Size[addr:Pointer]:Integer read FGetSize;
property BaseAddress[addr:Pointer]:Pointer read FGetBaseAddress;
end;
TExecMemManager=class(TMemoryManager)
function Allocate(dwSize:Cardinal):Pointer;override;
procedure Dispose(dwSize:Cardinal;Ptr:Pointer);override;
end;
TFixedMemManager=class(TMemoryManager)
function Allocate(dwSize:Cardinal):Pointer;override;
procedure Dispose(dwSize:Cardinal;Ptr:Pointer);override;
end;
var MemoryCollector:TMemoryCollector;
implementation