March 26, 2014 at 17:37

Misuse of atoms and subtle bug in VCL

    image

    Bug search


    I was tormented for a long time by a bug related to the inadequate behavior of the Delphic controls after a long uptime of the system and intensive debugging. Lists stopped updating, buttons were pressed, input fields began to lose focus. And everything was sad, and restarting the IDE did not help. Moreover, after restarting the IDE, it itself began to fail as well. I had to reboot.
    Today it bothered me, and I began to look for her. I must say not to no avail.
    Having pledged window messages, I began to analyze what went wrong.
    It turned out that the Control.pas module has these lines:
    function FindControl(Handle: HWnd): TWinControl;
var
  OwningProcess: DWORD;
begin
  Result := nil;
  if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and
     (OwningProcess = GetCurrentProcessId) then
  begin
    if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then
      Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)))
    else
      Result := ObjectFromHWnd(Handle);
  end;
end;

    and GetProp (Handle, MakeIntAtom (ControlAtom) ) always returns 0. Then it became clear that ControlAtom why is 0, and GlobalFindAtom (PChar (ControlAtomString)) returns 0. also
    initialized ControlAtomString and ControlAtom in procedure InitControls , which is called in the initialization section of the unit:
    procedure InitControls;
var
  UserHandle: HMODULE;
begin
{$IF NOT DEFINED(CLR)}
  WindowAtomString := Format('Delphi%.8X',[GetCurrentProcessID]);
  WindowAtom := GlobalAddAtom(PChar(WindowAtomString));
  ControlAtomString := Format('ControlOfs%.8X%.8X', [HInstance, GetCurrentThreadID]);
  ControlAtom := GlobalAddAtom(PChar(ControlAtomString));
  RM_GetObjectInstance := RegisterWindowMessage(PChar(ControlAtomString));
{$IFEND}

    The ControlAtomString is populated correctly, but the ControlAtom is populated with zero. There are no checks for errors here, so it came back much later, alas. If you insert GetLastError after GlobalAddAtom , it will return ERROR_NOT_ENOUGH_MEMORY . And if you still carefully read the remark on MSDN to GlobalAddAtom , you can see:
    Global atoms are not deleted automatically when the application terminates. For every call to the GlobalAddAtom function, there must be a corresponding call to the GlobalDeleteAtom function.


    Everything immediately becomes clear. If the application is terminated incorrectly, then global atoms will flow away. And the cat wept for named atoms: 0xC000-0xFFFF, that is, only 16383. That is each dll, and each exe-shnik written in Delphi using VCL upon incorrect completion leaves leaked global atoms. To be more precise, then there are 2-3 atoms per instance:
    ControlAtom and WindowAtom in Controls.pas, and WndProcPtrAtom in Dialogs.pas

    Workaround


    See created atoms is not difficult. Here is the code for a simple application listing global string atoms:
    program EnumAtomsSample;
{$APPTYPE CONSOLE}
uses
  Windows,
  SysUtils;
function GetAtomName(nAtom: TAtom): string;
var n: Integer;
    tmpstr: array [0..255] of Char;
begin
  n := GlobalGetAtomName(nAtom, PChar(@tmpstr[0]), 256);
  if n = 0 then
    Result := ''
  else
    Result := tmpstr;
end;
procedure EnumAtoms;
var i: Integer;
    s: string;
begin
  for i := MAXINTATOM to MAXWORD do
    begin
      s := GetAtomName(i);
      if (s <> '') then WriteLn(s);
    end;
end;
begin
  try
    EnumAtoms;
    ReadLn;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

    You can make sure that the atoms flow by starting any VCL project, and nailing it through the task manager.

    Since the atoms are global, we can nail them, regardless of who they were created. It remains to somehow learn to determine that the atom has leaked.
    If we look at the names of atoms, then for
    WndProcPtrAtom it is WndProcPtr [HInstance] [ThreadID]
    ControlAtom it is ControlOfs [HInstance] [ThreadID]
    WindowAtom it is Delphi [ProcessID]
    In all cases, we can understand that the atom is most likely created by Delphi by a specific prefix + one or two 32-bit numbers in the HEX. In addition, either ProcessID or ThreadID is written to the HEX. We can easily check if there is such a process or thread in the system. If not, then we have a clearly leaked atom, and we may risk releasing it. Yes, yes, take a chance. The fact is that after we made sure that there is no thread / process with this ID, and are going to delete the atom, this process may appear with exactly the same ID and turn out to be a Delphi process. If in the interval between verification and deletion this happens, then we will beat the atom from the valid application. The situation is extremely unlikely, because in the interval between the checks, a necessarily Delphic process must be created, be sure to use exactly the same ID, and be sure to have time to initialize its atoms.

    I wrote a console tool for cleaning such leaked global atoms.
    Here is the code for this tool:
    program AtomCleaner;
{$APPTYPE CONSOLE}
uses
  Windows,
  SysUtils;
const
  THREAD_QUERY_INFORMATION = $0040;
function OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwThreadId: DWORD): THandle; stdcall; external kernel32;
function ThreadExists(const ThreadID: Cardinal): Boolean;
var h: THandle;
begin
  h := OpenThread(THREAD_QUERY_INFORMATION, False, ThreadID);
  if h = 0 then
  begin
    Result := False;
  end
  else
  begin
    Result := True;
    CloseHandle(h);
  end;
end;
function TryHexChar(c: Char; out b: Byte): Boolean;
begin
  Result := True;
  case c of
    '0'..'9':  b := Byte(c) - Byte('0');
    'a'..'f':  b := (Byte(c) - Byte('a')) + 10;
    'A'..'F':  b := (Byte(c) - Byte('A')) + 10;
  else
    Result := False;
  end;
end;
function TryHexToInt(const s: string; out value: Cardinal): Boolean;
var i: Integer;
    chval: Byte;
begin
  Result := True;
  value := 0;
  for i := 1 to Length(s) do
  begin
    if not TryHexChar(s[i], chval) then
      begin
        Result := False;
        Exit;
      end;
    value := value shl 4;
    value := value + chval;
  end;
end;
function GetAtomName(nAtom: TAtom): string;
var n: Integer;
    tmpstr: array [0..255] of Char;
begin
  n := GlobalGetAtomName(nAtom, PChar(@tmpstr[0]), 256);
  if n = 0 then
    Result := ''
  else
    Result := tmpstr;
end;
function CloseAtom(nAtom: TAtom): Boolean;
var n: Integer;
    s: string;
begin
  Result := False;
  s := GetAtomName(nAtom);
  if s = '' then Exit;
  WriteLn('Closing atom: ', IntToHex(nAtom, 4), ' ', s);
  GlobalDeleteAtom(nAtom);
  Result := True;
end;
function ProcessAtom(nAtom: TAtom): Boolean;
var s: string;
    n: Integer;
    id: Cardinal;
begin
  Result := False;
  s := GetAtomName(nAtom);
  n := Pos('ControlOfs', s);
  if n = 1 then
  begin
    Delete(s, 1, Length('ControlOfs'));
    if Length(s) <> 16 then Exit;
    Delete(s, 1, 8);
    if not TryHexToInt(s, id) then Exit;
    if not ThreadExists(id) then
        Exit(CloseAtom(nAtom));
    Exit;
  end;
  n := Pos('WndProcPtr', s);
  if n = 1 then
  begin
    Delete(s, 1, Length('WndProcPtr'));
    if Length(s) <> 16 then Exit;
    Delete(s, 1, 8);
    if not TryHexToInt(s, id) then Exit;
    if not ThreadExists(id) then
        Exit(CloseAtom(nAtom));
    Exit;
  end;
  n := Pos('Delphi', s);
  if n = 1 then
  begin
    Delete(s, 1, Length('Delphi'));
    if Length(s) <> 8 then Exit;
    if not TryHexToInt(s, id) then Exit;
    if GetProcessVersion(id) = 0 then
      if GetLastError = ERROR_INVALID_PARAMETER then
        Exit(CloseAtom(nAtom));
    Exit;
  end;
end;
procedure EnumAndCloseAtoms;
var i: Integer;
begin
  i := MAXINTATOM;
  while i <= MAXWORD do
  begin
    if not ProcessAtom(i) then
        Inc(i);
  end;
end;
begin
  try
    EnumAndCloseAtoms;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.


    Just run, the leaked atoms are cleaned. Check, maybe right now you already have leaked atoms in the system.

    Finally


    Inspection of the code showed that these global atoms are used only for SetProp and GetProp functions. It is completely incomprehensible why the Delphi developers decided to use atoms. After all, both of these functions work fine with pointers to strings. It is enough to transmit a unique string, which in itself already exists, because an atom is initialized with it.
    The logic of such comparisons in VCL code is also incomprehensible:
    if GlobalFindAtom (PChar (ControlAtomString)) = ControlAtom then
    Both variables are initialized in one place. The string is going to be unique (from HInstance and ThreadID). Validation will always return True. Alas, Delphi is now promoting new features, all sorts of FMXs. It is unlikely that they will fix this bug. Personally, I don’t even want to report on QC, knowing how it fixes. But somehow you have to live with it. Those who wish can execute the code of the above tool at the start of their application. In my opinion, this is in every way better than waiting for leaked atoms.
    Well, in our own developments, we should try to avoid global atoms, because the OS does not control their leakage.

    Tools + sources
    Tags:

    Also popular now: