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.
