Monitoring tool for global atom table and RegisterWindowMessage identifiers.

"An atom table is a system-defined table that stores strings and corresponding identifiers. An application places a string in an atom table and receives a 16-bit integer, called an atom, that can be used to access the string. A string that has been placed in an atom table is called an atom name"

Source: Microsoft - About Atom tables

With ATOM table Monitor, all created atoms using RegisterClass, RegisterClassEx, GlobalAddAtom, AddAtom or identifiers from RegisterWindowMessage functions can be monitored and be sure our applications are not leaking Atoms / identifiers.

Related Articles:

• Monitoring Global Atom table part I
• Monitoring Global Atom table part II
• Monitoring Global Atom table part III

Features:

• Monitor Global atom entries from 0xC000 to 0xFFFF using GlobalGetAtomName.
• Monitor RegisterWindowMessage atom entries (identifiers) from 0xC000 to 0xFFF using GetClipboardFormatName.
• Memory displayed in a nice way using a memory grid.
• Match pattern using regular expressions.
• Graph displaying current values.
• Testing table entries using GlobalAddAtom and RegisterWindowMessage functions.
• Monitoring user session atoms and Service session atoms.
• Windows 10 support.

Notes:

• It uses *C:* drive for internal use as it is hard-coded. (Be sure you have that drive in your system)

Version 1.6:

Global atom table: RegisterWindowMessage table: Display list of entries: Matching string patterns: Counters: Test screen: Session screen selection: Monitoring Service session atoms:

Scan Atoms method:

procedure ScanAtoms;
var
  i: word;
  cstrAtomName: array [0 .. 1024] of char;
  cstrRWMName: array [0 .. 1024] of char;
  AtomName, RWMName: string;
  len, lenRWM: integer;
  Value: string;
  countAtom, countRWM: integer;
begin
  countAtom := 0;
  countRWM := 0;
  for i := $C000 to $FFFF do
  begin
    Value := '';
    len := GlobalGetAtomName(i, cstrAtomName, 1024);
    lenRWM := GetClipboardFormatName(i, cstrRWMName, 1024);
    if len > 0 then
    begin
      AtomName := StrPas(cstrAtomName);
      SetLength(AtomName, len);
      Value := AtomName;
      Inc(countAtom);
      FATomTable[i - $C000].atom[0] := Value + '  --GlobalAtom';
    end;
    if lenRWM > 0 then
    begin
      RWMName := StrPas(cstrRWMName);
      SetLength(RWMName, lenRWM);
      Value := RWMName;
      Inc(countRWM);
      FATomTable[i - $C000].atom[1] := Value + '  --RWM';
    end;
  end;
end;

Using regular expressions:

function GetColor(Text: string): TColor;
  var
    i: integer;
    perl: TPerlRegEx;
    res: TColor;
  begin
    res := clGray;
    for i := 0 to FListPatterns.count - 1 do
    begin
      perl := TPerlRegEx.Create;
      try
        perl.RegEx := UTF8String(FListPatterns[i].RegularEx);
        perl.Subject := UTF8String(Text);
        if perl.Match then
        begin
          res := FListPatterns[i].color;
          Break;
        end;
      finally
        perl.Free;
      end;
    end;
    result := res;
  end;

Testing:

procedure AddatomClick(Sender: TObject);
var
  i: integer;
begin
  try
    GlobalAddAtom(PChar(getRandomString(Edit4.Text)));
    if GetLastError <> 0 then
    begin
      ShowMessage(IntToStr(GetLastError) + ' ' + SysErrorMessage(GetLastError));
      Break;
    end;
  Except
    on e: exception do
      ShowMessage(e.message + ' ' + IntToStr(GetLastError));
  end;
end;

procedure RWMAddAtom(Sender: TObject);
var
  i: integer;
  myString: string;
begin
  myString := getRandomString(Edit8.Text);
  try
    RegisterWindowMessage(PWideChar(myString));
    if GetLastError <> 0 then
    begin
      ShowMessage(IntToStr(GetLastError) + ' ' + SysErrorMessage(GetLastError));
      Break;
    end;
  Except
    on e: exception do
      ShowMessage(e.message + ' ' + IntToStr(GetLastError));
  end;
end;

function getRandomString(header: string): string;
const
  Chars = '1234567890ABCDEFGHJKLMNPQRSTUVWXYZ!?/*+-';
var
  S: string;
  i, N: integer;
begin
  Randomize;
  S := '';
  for i := 1 to 6 do
  begin
    N := Random(Length(Chars)) + 1;
    S := S + Chars[N];
  end;
  result := header + S;
end;

Testing using RegisterClassEx

procedure btnCreateClick(Sender: TObject);
var
  WC: TWndclassEx;
  atom: word;
begin
  WC.lpszclassName := PWideChar(Edit10.Text);
  WC.cbSize := SizeOf(TWndclassEx);
  WC.style := CS_VREDRAW or CS_HREDRAW;
  WC.lpfnWndProc := @DefWindowProc;
  WC.cbClsExtra := 0;
  WC.cbWndExtra := 0;
  WC.hinstance := hinstance;
  WC.hIcon := Application.Icon.Handle;
  WC.hIconSm := Application.Icon.Handle;
  WC.hCursor := LoadCursor(0, IDC_ARROW);
  WC.lpszMenuName := nil;
  WC.hbrBackground := (COLOR_BACKGROUND + 1);

  atom := RegisterClassEx(WC);
  if atom <> 0 then
    ShowMessage('Atom Created at ' + IntToHex(atom, 4));
end;

Tested under:

• Windows Xp, Vista, 7, Server 2003, Server 2008, Windows 10

Developed under:

• Delphi 2010

StackOverflow entry:

• System Error. Code: 8. Not enough storage is available to process this command

Microsoft Debug Blog entry:

• Identifying global atom table leaks.

Sponsors

No sponsors yet! Will you be the first?