We have a few Win32 applications (coded in Delphi 2006) where sometimes the user gets an error message saying \"System Error. Code: 8. Not enough storage is availabl
I have been searching for 2 year and thanks to Jordi Corbilla answer I have finally got it!
In a few words: Delphi source has bugs that is causing you this problem!
Let's understand what is going on:
Windows has a memory area called "Atom table", wich serves to applications communicate each other (see more).
Also, Windows has another "memory area", called "Window Message System", wich serves to the same purpose (see more).
Both these memory areas have "16k slots" each. In the first one, it is possible to REMOVE an atom, by using the following Windows API:
GlobalDeleteAtom // for removing an atom added by "GlobalAddAtom"
In the second "area", we just CAN'T REMOVE anything!
The RegisterWindowMessage function is typically used to register messages for communicating between two cooperating applications. If two different applications register the same message string, the applications return the same message value. The message remains registered until the session ends.
Delphi compiled applications (by D7 at least) will put a record in "Messaging Area" and some others records in "Atom Table" EVERY TIME THEY ARE STARTED. The application tries to remove them when app is closing, but I have find many (and many) "atom leaks", even after app is closed.
At this point you can see that if you have a server that starts thousands of app a day, you probably should reach the 16k limit soon, and the problem begins! The solution at this point? Nothing but a single reboot.
So, what can we do? Well my friend, I'm sorry to tell you, but we need to FIX Delphi source code and recompile all applications.
First, open the unit Controls.pas and replace the following line:
RM_GetObjectInstance := RegisterWindowMessage(PChar(ControlAtomString));
for:
RM_GetObjectInstance := RegisterWindowMessage('RM_GetObjectInstance');
and then recompile Delphi packages and your applications.
As I have found atom leaks even after app is closed, I created an app that garbage collects any atom left behind. It just runs the following code every hour:
procedure GarbageCollectAtoms;
var i, len : integer;
cstrAtomName: array [0 .. 1024] of char;
AtomName, Value, procName: string;
ProcID,lastError : cardinal;
countDelphiProcs, countActiveProcs, countRemovedProcs, countCantRemoveProcs, countUnknownProcs : integer;
// gets program's name from process' handle
function getProcessFileName(Handle: THandle): string;
begin
Result := '';
{ not used anymore
try
SetLength(Result, MAX_PATH);
if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then
SetLength(Result, StrLen(PChar(Result)))
else
Result := '';
except
end;
}
end;
// gets the last 8 digits from the given atomname and try to convert them to and integer
function getProcessIdFromAtomName(name:string):cardinal;
var l : integer;
begin
result := 0;
l := Length(name);
if (l > 8) then
begin
try
result := StrToInt64('$' + copy(name,l-7,8));
except
// Ops! That should be an integer, but it's not!
// So this was no created by a 'delphi' application and we must return 0, indicating that we could not obtain the process id from atom name.
result := 0;
end;
end;
end;
// checks if the given procID is running
// results: -1: we could not get information about the process, so we can't determine if is active or not
// 0: the process is not active
// 1: the process is active
function isProcessIdActive(id: cardinal; var processName: string):integer;
var Handle_ID: THandle;
begin
result := -1;
try
Handle_ID := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, id);
if (Handle_ID = 0) then
begin
result := 0;
end
else
begin
result := 1;
// get program's name
processName := getProcessFileName(Handle_ID);
CloseHandle(Handle_ID);
end;
except
result := -1;
end;
end;
procedure Log(msg:string);
begin
// Memo1.Lines.Add(msg);
end;
begin
// initialize the counters
countDelphiProcs := 0;
countActiveProcs := 0;
countRemovedProcs := 0;
countUnknownProcs := 0;
// register some log
Log('');
Log('');
Log('Searching Global Atom Table...');
for i := $C000 to $FFFF do
begin
len := GlobalGetAtomName(i, cstrAtomName, 1024);
if len > 0 then
begin
AtomName := StrPas(cstrAtomName);
SetLength(AtomName, len);
Value := AtomName;
// if the atom was created by a 'delphi application', it should start with some of strings below
if (pos('Delphi',Value) = 1) or
(pos('ControlOfs',Value) = 1) or
(pos('WndProcPtr',Value) = 1) or
(pos('DlgInstancePtr',Value) = 1) then
begin
// extract the process id that created the atom (the ProcID are the last 8 digits from atomname)
ProcID := getProcessIdFromAtomName(value);
if (ProcId > 0) then
begin
// that's a delphi process
inc(countDelphiProcs);
// register some log
Log('');
Log('AtomName: ' + value + ' - ProcID: ' + inttostr(ProcId) + ' - Atom Nº: ' + inttostr(i));
case (isProcessIdActive(ProcID, procName)) of
0: // process is not active
begin
// remove atom from atom table
SetLastError(ERROR_SUCCESS);
GlobalDeleteAtom(i);
lastError := GetLastError();
if lastError = ERROR_SUCCESS then
begin
// ok, the atom was removed with sucess
inc(countRemovedProcs);
// register some log
Log('- LEAK! Atom was removed from Global Atom Table because ProcID is not active anymore!');
end
else
begin
// ops, the atom could not be removed
inc(countCantRemoveProcs);
// register some log
Log('- Atom was not removed from Global Atom Table because function "GlobalDeleteAtom" has failed! Reason: ' + SysErrorMessage(lastError));
end;
end;
1: // process is active
begin
inc(countActiveProcs);
// register some log
Log('- Process is active! Program: ' + procName);
end;
-1: // could not get information about process
begin
inc(countUnknownProcs);
// register some log
Log('- Could not get information about the process and the Atom will not be removed!');
end;
end;
end;
end;
end;
end;
Log('');
Log('Scan complete:');
Log('- Delphi Processes: ' + IntTostr(countDelphiProcs) );
Log(' - Active: ' + IntTostr(countActiveProcs) );
Log(' - Removed: ' + IntTostr(countRemovedProcs) );
Log(' - Not Removed: ' + IntTostr(countCantRemoveProcs) );
Log(' - Unknown: ' + IntTostr(countUnknownProcs) );
TotalAtomsRemovidos := TotalAtomsRemovidos + countRemovedProcs;
end;
(This code above was based on this code)
After that, I have never got this f** error again!
Late Update:
Also, that is the source of this error: Application error: fault address 0x00012afb