unit S_Heap;

interface

implementation

uses Windows;

// Save a function call each time by caching the process heap handle.
var
 Heap: THandle;
 os_win98: Boolean;

// Allocate Size bytes and return a pointer to uninitialized memory,
//  or nil for a failure.
function S_GetMem(Size: Integer): Pointer;
begin
 Result := HeapAlloc(Heap, 0, Size);
end;

// Free the pointer. Return 0 for success, and 1 for failure.
function S_FreeMem(Ptr: Pointer): Integer;
begin
 if HeapFree(Heap, 0, Ptr) then
  Result := 0
 else
  Result := 1;
end;

// Reallocate Size bytes, and return the new pointer, or nil.
function S_ReallocMem(Ptr: Pointer; Size: Integer): Pointer;
begin
 Result := HeapRealloc(Heap, 0, Ptr, Size);
end;

// Setup the new memory manager.
procedure InitMemoryManager;
var
 MemMgr: TMemoryManager;
begin
 if os_win98 then exit;
 Heap := GetProcessHeap;
 MemMgr.GetMem := S_GetMem;
 MemMgr.FreeMem := S_FreeMem;
 MemMgr.ReallocMem := S_ReallocMem;
 SetMemoryManager(MemMgr);
end;

// checks windows version
procedure CheckWindows;
var
 OSVersionInfo: TOSVersionInfo;
begin
 OSVersionInfo.dwOSVersionInfoSize:=SizeOf(OSVersionInfo);
 GetVersionEx(OSVersionInfo);
 os_win98:=OSVersionInfo.dwPlatformId=1;
end;

initialization
//   Install the new memory manager, so it will be used for all
//    future memory management.
 CheckWindows;
 InitMemoryManager;
end.