sharememrep.pas

来自「Sharemem replacement for Delphi. Fast, 」· PAS 代码 · 共 83 行

(*
  ShareMemRep Version: 1.1
  =========================
   - Aimingoo ([e-mail])
   - 2003.08.05
   - Free and OpenSource
*)

unit ShareMemRep;

interface

{ Same define in ShareMem.pas for Delphi }
var
  GetHeapStatus: function: THeapStatus;
  GetAllocMemCount: function: Integer;
  GetAllocMemSize: function: Integer;

implementation

uses
  Windows;

const
  Err_ReplaceFailed = 'Shared Memory Replace failed!'#$0D#$0A#$0D#$0A +
                      '  - Host App must uses ShareMemRep.pas!'#$0D#$0A +
                      '  - ShareMemRep.pas nust is first of uses list!';
var
  ExeName: array [0..255] of char;
  hExe: HModule;
  OldMemMgr: TMemoryManager;
  MemMgr: TMemoryManager;
  _GetMemoryManager: procedure (var MemMgr: TMemoryManager);

function _GetAllocMemCount: Integer;
begin
  Result := System.AllocMemCount;
end;

function _GetAllocMemSize: Integer;
begin
  Result := System.AllocMemSize;
end;

exports
  System.GetMemoryManager,
  System.GetHeapStatus,
  _GetAllocMemCount name 'GetAllocMemCount',   { Number of allocated memory blocks } 
  _GetAllocMemSize name 'GetAllocMemSize';     { Total size of allocated memory blocks }


initialization
  if IsLibrary then
  begin
    GetModuleFileName(0, @ExeName, 255);
    hExe := GetModuleHandle(@ExeName);
    _GetMemoryManager := GetProcAddress(hExe, 'GetMemoryManager');
    if (System.AllocMemSize<>0) or (hExe = 0) or (@_GetMemoryManager = nil) then
    begin
      MessageBox(0, Err_ReplaceFailed, 'ShareMemRep 1.0', 0);
      TerminateProcess(GetCurrentProcess, 0);
    end;
    GetHeapStatus := GetProcAddress(hExe, 'GetHeapStatus');
    GetAllocMemCount := GetProcAddress(hExe, 'GetAllocMemCount');
    GetAllocMemSize := GetProcAddress(hExe, 'GetAllocMemSize');

    _GetMemoryManager(MemMgr);
    GetMemoryManager(OldMemMgr);
    SetMemoryManager(MemMgr);
  end
  else
  begin
    GetHeapStatus := System.GetHeapStatus;
    GetAllocMemCount := _GetAllocMemCount;
    GetAllocMemSize := _GetAllocMemSize;
  end;


finalization
  if IsLibrary then
    SetMemoryManager(OldMemMgr);

end.