Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
  • Loading branch information
danieleteti committed Jun 21, 2023
1 parent 1bccc50 commit 0374d8f
Showing 1 changed file with 66 additions and 0 deletions.
66 changes: 66 additions & 0 deletions sources/MSHeap.pas
Original file line number Diff line number Diff line change
@@ -0,0 +1,66 @@
unit MSHeap;

// default MM override using Windows Heap API
// Roberto Della Pasqua www.dellapasqua.com
// 10 sept 2022 added inline directive, zeromemory and freemem return value
// 21 jun 2023 addition by Daniele Teti https://github.com/danieleteti/delphimvcframework

{$O+}

interface

uses Windows;

implementation

var
ProcessHeap: THandle;

function SysGetMem(Size: NativeInt): Pointer; inline;
begin
Result := HeapAlloc(ProcessHeap, 0, Size);
end;

function SysFreeMem(P: Pointer): Integer; inline; //thanks Daniele Teti delphimvc
begin
Result := 0;
if not HeapFree(ProcessHeap, 0, P) then Result := -1;
end;

function SysReallocMem(P: Pointer; Size: NativeInt): Pointer; inline;
begin
Result := HeapReAlloc(ProcessHeap, 0, P, Size);
end;

function SysAllocMem(Size: NativeInt): Pointer; inline;
begin
Result := HeapAlloc(ProcessHeap, 8, Size); // zeromemory in dwflags api call
end;

function SysRegisterExpectedMemoryLeak(P: Pointer): Boolean;
begin
Result := False;
end;

function SysUnregisterExpectedMemoryLeak(P: Pointer): Boolean;
begin
Result := False;
end;

const
MemoryManager: TMemoryManagerEx =
(
GetMem: SysGetmem;
FreeMem: SysFreeMem;
ReallocMem: SysReAllocMem;
AllocMem: SysAllocMem;
RegisterExpectedMemoryLeak: SysRegisterExpectedMemoryLeak;
UnregisterExpectedMemoryLeak: SysUnregisterExpectedMemoryLeak
);

initialization

ProcessHeap := GetProcessHeap;
SetMemoryManager(MemoryManager);

end.

0 comments on commit 0374d8f

Please sign in to comment.