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

后端 未结 7 2051
时光说笑
时光说笑 2020-11-27 12:32

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

相关标签:
7条回答
  • 2020-11-27 12:54

    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

    0 讨论(0)
提交回复
热议问题