bwerf's Blog

Eric Grange talks about having an alternative to FreeAndNil that instead of zeroing the object pointer make it another value that signals that the reference is invalid.

http://delphitools.info/2010/02/06/dont-abuse-freeandnil-anymore/#comments

On which i commented:

Alternatively something we do is hook FreeInstance to change the v-table pointer on the heapobject just before the FreeMemory call inside it. This causes all virtual method calls on the now freed object to throw a CalledAMethodOnAFreedObject exception when the memory hasn’t yet been reused or pageprotected. The overhead is neglectible and works without replacing .Free or FreeAndNil calls.

unit ReferenceProtector;

interface

implementation

uses
  SysUtils,
  Windows;

type
  TObjectProc = procedure of Object;
  TGlobalProc = procedure;
  TMyProc = procedure(Obj: Pointer);
  TSmack = record
    case Integer of
      1:( A: TObjectProc;);
      2:( C, D: Pointer;);
      3:( F: TGlobalProc; E: Integer;);
      4:( G: TMyProc; H: Integer;);
  end;
  TIntRec = record
    case Integer of
      1: (A: Pointer);
      2: (W, X, Y, Z: Byte);
      3: (B: Integer);
  end;

var
  NewFreeInstance: TSmack;
  OldFreeInstance: Pointer;
  CleanupInstance: Pointer;
  OriginalCode: array[0..5] of Byte;
  Freemem: Pointer;
  PoisonedVTable: Pointer;
  PoisonVTable: array[0..272] of Pointer;
  Loaded: Boolean;

procedure RaiseReferenceProtector(Obj: Pointer);
var
  s: string;
begin
  s := 'ReferenceProtector: Called a virtual method on a free''ed object. '+IntToHex(Integer(Obj), 8);
  try
    s := s + ' of type ' + TObject(Pointer(Cardinal(Obj)+4)).ClassName + '('+IntToHex(Integer(PPointer(Cardinal(Obj)+4)^), 8)+')';
  except
    s := s + ' of unknown classtype.'
  end;
  OutputDebugString(@s[1]);
  raise Exception.Create(s);
end;

procedure TObjectFreeInstanceReplacement;
asm
//  CleanupInstance;
  push ebx
  mov ebx, eax
  mov ecx, CleanupInstance
  call dword ptr ecx
// Poison the vmt
  mov eax, ebx
  mov ecx, [eax]
  mov [eax+4], ecx  // delphi garuantees 8 bytes of memory minimum for any allocation
  mov ecx, PoisonedVTable
  mov [eax], ecx
//  _FreeMem(Self);
  mov ecx, FreeMem
  call dword ptr ecx
  pop ebx
end;

procedure SetupEnforce;
var
  Proc: TSmack;
  FreeInstance: TSmack;
  OldFree: ^Byte;
  NewFree: TIntRec;
  OldProtection, Temp: DWord;
  X: TObject;
{$WARN SYMBOL_DEPRECATED OFF}
  MemMgr: TMemoryManager;
{$WARN SYMBOL_DEPRECATED ON}
  i: Integer;
begin
  PoisonedVTable := @PoisonVTable[16];
  Proc.g := RaiseReferenceProtector;
  for i := 0 to 272 do
    PoisonVTable[i] := Proc.C;

  X := TObject.Create;
  FreeInstance.A := X.FreeInstance;
  Proc.A := X.CleanupInstance;
  X.Free;
  OldFreeInstance := FreeInstance.C;
  OldFree := OldFreeInstance;
  CleanupInstance := Proc.C;

{$WARN SYMBOL_DEPRECATED OFF}
  GetMemoryManager(MemMgr);
{$WARN SYMBOL_DEPRECATED ON}

  Freemem := @MemMgr.FreeMem;

  NewFreeInstance.F := TObjectFreeInstanceReplacement;
  NewFree.A := @NewFreeInstance;

  // allow modifying the code section
  if VirtualProtect(OldFree, 8, PAGE_EXECUTE_READWRITE, @OldProtection) then
  begin

    // call
    OriginalCode[0] := OldFree^;
    OldFree^ := $ff;
    Inc(OldFree);
    // but no return on stack, indirect from address
    OriginalCode[1] := OldFree^;
    OldFree^ := $25;
    Inc(OldFree);
    // and then the address, per byte, wasn't sure about the endianness, below is correct
    OriginalCode[2] := OldFree^;
    OldFree^ := NewFree.W;
    Inc(OldFree);
    OriginalCode[3] := OldFree^;
    OldFree^ := NewFree.X;
    Inc(OldFree);
    OriginalCode[4] := OldFree^;
    OldFree^ := NewFree.Y;
    Inc(OldFree);
    OriginalCode[5] := OldFree^;
    OldFree^ := NewFree.Z;

    // restore old rights to code section
    VirtualProtect(OldFree, 8, OldProtection, @Temp);
    Loaded := True;
  end
  else
    OutputDebugString('ReferenceProtector: Failed to set the protection of virtual calls to free''ed objects.'#13#10);
end;

procedure UnloadEnforce;
var
  OldFree: ^Byte;
  OldProtection, Temp: DWord;
begin
  if not Loaded then
    Exit;
  OldFree := OldFreeInstance;

  if VirtualProtect(OldFree, 8, PAGE_EXECUTE_READWRITE, @OldProtection) then
  begin
    OldFree^ := OriginalCode[0];
    Inc(OldFree);
    OldFree^ := OriginalCode[1];
    Inc(OldFree);
    OldFree^ := OriginalCode[2];
    Inc(OldFree);
    OldFree^ := OriginalCode[3];
    Inc(OldFree);
    OldFree^ := OriginalCode[4];
    Inc(OldFree);
    OldFree^ := OriginalCode[5];
    VirtualProtect(OldFree, 8, OldProtection, @Temp);
    Loaded := False;
  end
  else
    OutputDebugString('ReferenceProtector: Failed to reset the protection of virtual calls to free''ed objects.'#13#10);
end;

var
  OriginalMemManager: TMemoryManagerEx;
  MemManager: TMemoryManagerEx;

type
  ECheckingMemoryManagerException = class(Exception);
threadvar
  ///keep a counter per thread of number of recursive entries into AllocError
  AllocErrorCounter: Integer;

procedure AllocError(Size: Integer);
begin
  if (AllocErrorCounter = 0) then
  begin
    Inc(AllocErrorCounter);
    try
      // Raise an exception that the Exception logger can catch
      raise ECheckingMemoryManagerException.Create('Out of memory. Size: ' + IntToStr(Size));
    finally
      Dec(AllocErrorCounter);
    end;
  end;
end;

function CheckingGetMem(Size: Integer): Pointer;
begin
  Result := OriginalMemManager.GetMem((Size + 7) and $7ffffff8);
  if (not Assigned(Result) and (Size <> 0)) or (Size < 0)  then
    AllocError(Size);
end;

// returns zero'ed memory
function CheckingAllocMem(Size: Cardinal): Pointer;
begin
  if Size >= 8 then
  begin
    Result := OriginalMemManager.AllocMem(Size);
    if Assigned(Result) then
      Exit;
  end
  else
  begin
    if Size > 0 then
    begin
      Result := OriginalMemManager.AllocMem(8); // so that refprotector works with very small objects
      if Assigned(Result) then
        Exit;
    end
  end;
  Result := nil;
  if Size <> 0 then
    AllocError(Size);
end;

initialization
  GetMemoryManager(OriginalMemManager);
  MemManager := OriginalMemManager;
  MemManager.GetMem := CheckingGetMem;
  MemManager.AllocMem := CheckingAllocMem;
  SetMemoryManager(MemManager);

  Loaded := False;
  SetupEnforce;
finalization
  UnloadEnforce;
  SetMemoryManager(OriginalMemManager);
end.

The mbt shoes can give you the utmost comfort for your feet. A pair of good <a href="http://www.mbtag.com/">cheap">http://www.mbtag.com/">cheap mbt shoes</a>can be so helpful to your feet. In a word, <a href="http://www.mbtag.com/"> MBT shoes </a>can never be your normal shoes. And so many kinds and colors of <a href="http://www.mbtag.com/">mbt shoes</a>are waiting for you to choose.

Its tempest sometimes proceeds from <A href="http://www.myairmaxmall.com/Womens-Nike-Air-Max-2009.html">cheap air max</A> a grimace. Its explosions, its days, its masterpieces, its prodigies, its epics, go forth to the bounds of the universe, and so also do its cock-and-bull stories. Its laugh is the mouth of a volcano <A href="http://www.myairmaxmall.com/Womens-Nike-Air-Max-2009.html">womens air max 2009</A> which spatters the whole earth. Its jests are sparks. It imposes its caricatures as well as its ideal on people, the highest <A href="http://www.myairmaxmall.com/Mens-Nike-Air-Max-90.html">air max 90 mens</A> monuments of human civilization accept its ironies and lend their eternity to its mischievous pranks. It is superb, it has a prodigious 14th of July, which delivers the globe, it forces <A href="http://www.myairmaxmall.com/Mens-Nike-Air-Max-90.html">mens nike air max 90</A> all nations to take the oath of tennis, its night of the 4th of August dissolves in three hours a thousand years of feudalism, it makes of its logic the muscle of unanimous will, it multiplies itself <A href="http://www.myairmaxmall.com/Mens-Nike-Air-Max-95.html">air max 95 mens</A> under all sorts of forms of the sublime, it fills with <A href="http://www.myairmaxmall.com/Mens-Nike-Air-Max-95.html">nike air max 95</A> its light Washington, Kosciusko, Bolivar, Bozzaris, Riego, Bem, Manin, Lopez, John Brown, Garibaldi, it is everywhere where the future is being lighted up, at Boston in 1779, at the Isle de Leon in 1820, at Pesth in 1848, at Palermo in 1860, it whispers <A href="http://www.myairmaxmall.com/Mens-Nike-Air-Max-2010.html">nike air max 2010 mens</A> the mighty countersign: Liberty, in the ear of the American abolitionists grouped about the boat at <A href="http://www.myairmaxmall.com/Mens-Nike-Air-Max-2010.html">mens nike air max</A> Harper's Ferry, and in the ear of the patriots of Ancona assembled in the shadow, to the Archi before the Gozzi inn on the seashore, it creates Canaris, it creates Quiroga, it creates Pisacane, it irradiates <A href="http://www.myairmaxmall.com/Mens-Nike-Air-Structure-Triax-91.html">air">http://www.myairmaxmall.com/Mens-Nike-Air-Structure-Triax-91.html">air structure triax 91 mens</A> the great on earth, it was while proceeding whither its breath urge them, that Byron perished at Missolonghi, and that Mazet died at Barcelona, it is the tribune under the feet of Mirabeau, and a crater <A href="http://www.myairmaxmall.com/Mens-Nike-Air-Structure-Triax-91.html">air">http://www.myairmaxmall.com/Mens-Nike-Air-Structure-Triax-91.html">air structure triax 91</A> under the feet of Robespierre, its books, its theatre, its art, its science, its literature, its philosophy, are the manuals of the human race, it has Pascal, Regnier, Corneille, <A href="http://www.myairmaxmall.com/Mens-Nike-Air-Max-2009.html">air max 2009 men</A> Descartes, Jean-Jacques: Voltaire for all moments, Moliere for all centuries, it makes its language to be talked by the universal mouth, and that language <A href="http://www.myairmaxmall.com/Mens-Nike-Air-Max-2009.html">nike air max</A> becomes the word. wsf

THANKS

replica Cartier Jewelry

Hall his odd look, and locked the door.As Hall banged on the the <i><b><a href="http://www.designerbagforsale.com/">cheap designer handbags</a></b></i> the door, "I heard him say, 'Charlie, I've got a big surprise