
Bug finder
I was tormented by a bug for a long time, due to the inadequate behavior of the Delphi controls after a long uptime of the system and intensive debugging. The lists ceased to be updated, the buttons were pressed, the 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 got me, and I began to look for her. I must say no avail.
Having pledged window messages, I began to analyze what went wrong.
It turned out that there are such lines in the module Control.pas:
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 turned out that
ControlAtom is 0 for some reason, and
GlobalFindAtom (PChar (ControlAtomString)) also returns 0.
ControlAtomString and
ControlAtom are initialized in the
InitControls procedure, which is called in the module initialization section:
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}
ControlAtomString is filled correctly, but
ControlAtom is filled with zero. There are no checks for errors here, so this came back much later, alas. If you insert
GetLastError after
GlobalAddAtom , it will return
ERROR_NOT_ENOUGH_MEMORY . And if you also carefully read the remark on MSDN to
GlobalAddAtom , then you will notice:
Global atoms are not automatically deleted when the application terminates. For the GlobalAddAtom function, there is a corresponding call to the GlobalDeleteAtom function.
Everything at once becomes clear. If it is incorrect to terminate the application, then global atoms will leak. And the cat wept at the named atoms: 0xC000-0xFFFF, that is, only 16383. That is, each dll, and each exe-shnik written in Delphi using VCL with incorrect completion leaves the leaked global atoms behind. To be more precise - then 2-3 atoms for each instance:
ControlAtom and
WindowAtom in Controls.pas, and
WndProcPtrAtom in Dialogs.pas
Workaround
View 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 atoms flow by running 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 by. It remains to somehow learn to determine that the atom is leaked.
If you pay attention to the names of atoms, then for
WndProcPtrAtom is WndProcPtr [HInstance] [ThreadID]
ControlAtom is ControlOfs [HInstance] [ThreadID]
WindowAtom is Delphi [ProcessID]
In all cases, we can understand that the atom is most likely created by Delphi by the specific prefix + one or two 32-bit numbers in HEX-e. In addition, either ProcessID or ThreadID is recorded in the HEX. We can easily check there is such a process or flow in the system. If not, then we have a clearly leaked atom, and we can risk releasing it. Yes, yes, take a chance. The fact is that after we made sure that there is no thread / process with such an ID, and we are going to delete an atom, this process can appear, with exactly the same ID, and turn out to be a Delphi process. If in the interval between checking and deleting this happens, we will kill the atom in a valid application. The situation is extremely unlikely, because in the interval between the check, a Delphic process must be created, it must be exactly the same ID, and you must have time to initialize your atoms. I do not see any other workarounds (without editing the VCL code) to solve this problem.
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, leaking atoms cleaned. Check, maybe right now you have leaked atoms in the system.
Finally
Code inspection has shown 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 pass a unique string, which itself already exists, because the atom is initialized with it.
The logic of such comparisons in the VCL code is also incomprehensible:
if GlobalFindAtom (PChar (ControlAtomString)) = ControlAtom thenBoth variables are initialized in the same place. The string is going to be unique (from HInstance and ThreadID). Verification will always return true. Alas, Delphi is now promoting new features, FMX-s all. It is unlikely that they will fix this bug. Personally, I don't even have the desire to report on QC, knowing how it is fixed. But to live with this somehow necessary. Those interested can execute the code of the above tool when starting their application. In my opinion, this is better than waiting for leaked atoms.
Well, in our own development, you should try to avoid global atoms, because the OS does not control their leakage.
Tulsa + source