"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.

Notes:

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

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

Developed under:

• Delphi 2010