[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 291
  • Last Modified:

Memory problems - GetSysMem

My problem is that my application crashes more or less randomly on memory allocation. This happens without the debugger traping any exception.

Since the program is huge, there is probably something that changes a memory address somewhere that it shouldn't and ruins the memory allocation tables or something..

Does anyone know of a good memory debugging program for Delphi/Windows like ElectricFence or similar to Unix that checks for illegal memory tempering?

0
mortenmo
Asked:
mortenmo
  • 2
1 Solution
 
intheCommented:
Hi
try a  program called Memproof.  It has detailed instructions to show you what line numbers of errors , view the stack, pointers, etc during execution,should sort out the memory problem.  
 
http://www.totalqa.com/download/thirdparty.html 


Regards Barry
0
 
mortenmoAuthor Commented:
No, memproof doesn't work. I'm using that, but it doesn't trap the error.

I need something like ElectricFence that for every allocation that is done it allocates the area before and after so if you have somewhere in your program a pointer that accesses too far, an exception is done instead of
tempering with something it shouldn't.

Since this is urgent I raise the number of points to 300.
0
 
MadshiCommented:
This one is quite good:

http://www.multimania.com/vincentmahon/memcheck.htm

Or use my self-written unit, but you have to import it as the VERY FIRST unit in your project.

My unit checks if someone has overwritten the bytes before and after the allocated buffer everytime, you free or reallocate a buffer.

AND you can call CheckPointers at everytime. CheckPointers simply checks ALL allocated memory blocks, if one of those blocks is overwritten.

// *********************************************************************
//  mm.pas  ·  version: 1.0  ·  date: November 19, 1999
//  -------------------------------------------------------------------
//  Memory manager, checks memory overrun, double deallocation, ...
//  -------------------------------------------------------------------
//  Copyright (C) 1999 Madshi, All Rights Reserved
//  -------------------------------------------------------------------
//  beam.to/madshi  ·  madshi@gmx.net  ·  suggestions/comments welcome!
// *********************************************************************

unit mm;

{$define HookMemoryManager}

interface

function CheckPointers : integer;

implementation

uses Windows, Messages;

type
  TPCardinal = ^cardinal;
  TPInteger  = ^integer;

type
  TBufHead = record
    magic : cardinal;
    size_ : integer;
    index : integer;
  end;
  TBuf = record
    head : TBufHead;
    buf  : array [0..maxInt - 16] of byte;
  end;
  TPBuf = ^TBuf;
  TBufs = array [0..maxInt shr 2 - 1] of TPBuf;

var
  MMSection   : TRTLCriticalSection;
  Bufs        : ^TBufs  = nil;
  BufCapacity : integer =   0;
  BufCount    : integer =   0;

type
  Exception = class(TObject)
  private
    FMessage : string;
  public
    constructor Create(const Msg: string);
  end;

constructor Exception.Create(const Msg: string);
begin
  FMessage := Msg;
end;

function ReturnAddr(paramLength: integer) : pointer;
asm
  MOV EAX, [EBP + 36 + paramLength]
end;

function Buf_Set(buf: TPBuf; size: integer) : pointer;
begin
  with buf^, head do begin
    magic := $77777777;
    size_ := size;
    TPCardinal(@buf[size_])^ := $77777777;
    result := @buf;
  end;
  Bufs[buf^.head.index] := buf;
end;

function Buf_Add(buf: TPBuf; size: integer) : pointer;
begin
  if buf <> nil then begin
    if BufCount = BufCapacity then begin
      if BufCapacity < 8 then BufCapacity := 16
      else                    BufCapacity := BufCapacity + BufCapacity div 2;
      if Bufs = nil then Bufs := SysGetMem(BufCapacity * 4)
      else               Bufs := SysReallocMem(Bufs, BufCapacity * 4);
    end;
    inc(BufCount);
    buf^.head.index := BufCount - 1;
    result := Buf_Set(buf, size);
  end else result := nil;
end;

function Buf_Check(action: string; buf: pointer; paramLength: integer) : TPBuf;
begin
  if buf <> nil then begin
    if cardinal(buf) < sizeOf(TBufHead) then
      raise Exception.Create(action + 'Invalid pointer!') at ReturnAddr(paramLength);
    result := pointer(cardinal(buf) - sizeOf(TBufHead));
    if IsBadReadPtr(result, sizeOf(TBufHead)) then
      raise Exception.Create(action + 'Unaccessible pointer!') at ReturnAddr(paramLength);
    with result^, head do begin
      if magic = $88888888 then
        raise Exception.Create(action + 'Pointer already destroyed!') at ReturnAddr(paramLength);
      if magic <> $77777777 then
        raise Exception.Create(action + 'Invalid pointer!') at ReturnAddr(paramLength);
      if IsBadReadPtr(result, sizeOf(TBufHead) + size_ + 4) then
        raise Exception.Create(action + 'Unaccessible pointer!') at ReturnAddr(paramLength);
      if TPCardinal(@buf[size_])^ <> $77777777 then
        raise Exception.Create(action + 'Memory overwritten!') at ReturnAddr(paramLength);
      if index >= BufCount then
        raise Exception.Create(action + 'Memory overwritten!') at ReturnAddr(paramLength);
      if Bufs[index] <> result then
        raise Exception.Create(action + 'Memory overwritten!') at ReturnAddr(paramLength);
    end;
  end else result := nil;
end;

function Buf_Del(buf: TPBuf; paramLength: integer) : integer;
begin
  Buf_Check('Other pointer: ', @Bufs[BufCount - 1]^.buf, paramLength)^.head.index := buf^.head.index;
  Bufs[buf^.head.index] := Bufs[BufCount - 1];
  dec(BufCount);
  buf^.head.magic := $88888888;
  result := SysFreeMem(buf);
end;

function CheckPointers : integer;
{$ifdef HookMemoryManager} var i1 : integer; {$endif}
begin
  {$ifdef HookMemoryManager}
    EnterCriticalSection(MMSection);
    try
      result := BufCount;
      for i1 := 0 to result - 1 do
        Buf_Check('CheckPointers: ', @Bufs[i1]^.buf, 0);
    finally LeaveCriticalSection(MMSection) end;
  {$else}
    result := 0;
  {$endif}
end;

function SpecialGetMem(size : integer) : pointer;
begin
  if size <> 0 then begin
    EnterCriticalSection(MMSection);
    try
      result := Buf_Add(SysGetMem(size + sizeOf(TBufHead) + 4), size);
    finally LeaveCriticalSection(MMSection) end;
  end else result := nil;
end;

function SpecialFreeMem(p: pointer) : integer;
var buf : TPBuf;
begin
  if p <> nil then begin
    EnterCriticalSection(MMSection);
    try
      buf := Buf_Check('FreeMem: ', p, 4);
      result := Buf_Del(buf, 24);
    finally LeaveCriticalSection(MMSection) end;
  end else result := 0;
end;

function SpecialReallocMem(p: pointer; size: integer) : pointer;
var buf : TPBuf;
begin
  if p <> nil then begin
    EnterCriticalSection(MMSection);
    try
      buf := Buf_Check('ReallocMem: ', p, 12);
      if size = 0 then begin
        Buf_Del(buf, 12);
        result := nil;
      end else
        result := Buf_Set(SysReallocMem(buf, size + sizeOf(TBufHead) + 4), size);
    finally LeaveCriticalSection(MMSection) end;
  end else
    if size <> 0 then begin
      EnterCriticalSection(MMSection);
      try
        result := Buf_Add(SysGetMem(size + sizeOf(TBufHead) + 4), size);
      finally LeaveCriticalSection(MMSection) end;
    end else result := nil;
end;

var SpecialMemoryManager : TMemoryManager = (GetMem     : SpecialGetMem;
                                             FreeMem    : SpecialFreeMem;
                                             ReallocMem : SpecialReallocMem);

function MessageBoxThreadProc(dummy: pointer) : integer; stdcall;
begin
  result := 0;
  MessageBox(0, 'Madshi''s Memory Manager...', 'Info...', 0);
end;

function EnumThreadWndProc(window: cardinal; dummy: pointer) : bool; stdcall;
begin
  result := false;
  PostMessage(window, WM_CLOSE, 0, 0);
end;

procedure HookMemoryManager;
var tid, th : cardinal;
begin
  InitializeCriticalSection(MMSection);
  th := CreateThread(nil, 0, @MessageBoxThreadProc, nil, 0, tid);
  try
    if WaitForSingleObject(th, 1000) <> WAIT_OBJECT_0 then
      EnumThreadWindows(tid, @EnumThreadWndProc, 0);
  finally CloseHandle(th) end;
  SetMemoryManager(SpecialMemoryManager);
end;

{$ifdef HookMemoryManager}
  initialization
    HookMemoryManager;
  {$endif}
end.

Regards, Madshi.
0
 
mortenmoAuthor Commented:
Good thats just what I needed. Thanks.
0

Featured Post

[Webinar] Kill tickets & tabs using PowerShell

Are you tired of cycling through the same browser tabs everyday to close the same repetitive tickets? In this webinar JumpCloud will show how you can leverage RESTful APIs to build your own PowerShell modules to kill tickets & tabs using the PowerShell command Invoke-RestMethod.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now