Search code examples
delphiwinapimemory-managementdelphi-10.4-sydney

Complex problem when trying to free a StringList with objects crashes my app


In a Delphi 10.4.2 win-32 VCL Application in Windows 10, I use this code to collect the handles and program paths of some windows:

function GetPathFromPID(const PID: Cardinal): string;
var
  hProcess: THandle;
  Path: array[0..MAX_PATH - 1] of Char;
begin
  hProcess := Winapi.Windows.OpenProcess(Winapi.Windows.PROCESS_QUERY_INFORMATION or Winapi.Windows.PROCESS_VM_READ, False, PID);
  if hProcess <> 0 then
  try
    if Winapi.PsAPI.GetModuleFileNameEx(hProcess, 0, Path, Winapi.Windows.MAX_PATH) = 0 then
      RaiseLastOSError;
    Result := Path;
  finally
    Winapi.Windows.CloseHandle(hProcess)
  end
  else
    RaiseLastOSError;
end;

function EnumWinProc(wHandle: Winapi.Windows.HWND; aList: TStringList): Winapi.Windows.Bool; stdcall;
var
  strPath: string;
  IsAppMainWin: Boolean;
  ProcId: Cardinal;
begin
  IsAppMainWin := IsWindowVisible(wHandle)              and // Visible
    (GetWindow(wHandle, Winapi.Windows.GW_OWNER) = 0)   and // Not owned by other windows
    (GetParent(wHandle) = 0)                            and // Does not have any parent
    (GetWindowLong(wHandle, Winapi.Windows.GWL_EXSTYLE) and Winapi.Windows.WS_EX_TOOLWINDOW = 0); // Not a tool window

  if IsAppMainWin then
  begin
    GetWindowThreadProcessID(wHandle, ProcId);

    try
      strPath := GetPathFromPID(ProcId);
    except
      strPath := 'UnknownProgramPath';
    end;

    aList.AddObject(strPath, TObject(wHandle));
  end;

  Result := True;
end;

procedure ClearList(List: TStringList);
// https://stackoverflow.com/questions/9148659/how-to-free-objects-in-stringlist-in-delphi-7
var
  i: Integer;
begin
  // crash occurs here!
  for i := 0 to pred(List.Count) do
    List.Objects[i].Free;
  List.Clear;
end;

procedure TformMain.OutputAllAppWindows;
begin
  var sl := TStringList.Create;
  try
    sl.OwnsObjects := True;

    EnumWindows(@EnumWinProc, Winapi.Windows.LPARAM(sl));

    for var i := 0 to sl.Count - 1 do
    begin
      CodeSite.Send('window handle', Winapi.Windows.HWND(sl.Objects[i]));
      CodeSite.Send('program-path sl[i]', sl[i]);
    end;
    ClearList(sl); // EDIT: forgot this line!
  finally
    sl.Free; 
  end;
end;

The crash is reported by EurekaLog:

enter image description here

2.1 Date : Sat, 31 Jul 2021 22:36:53 +0200
2.2 Address : 005509D2
2.5 Type : EInvalidPointer
2.6 Message : Application made attempt to free invalid or unknown memory block: $00010AE2 OBJECT [?] 0 bytes.
2.7 ID : B5002468
2.8 Count : 1
2.11 Sent : 0

This is at the top of the EurekaLog call stack:

enter image description here


Solution

  • There are two problems here:

    First, you are putting integers as objects in the string list, so you mustn't treat these "objects" as objects, because they aren't.

    In particular, there isn't anything to free, and you mustn't free these "objects"; that would be equivalent to doing TObject(some random pointer).Free.

    Second, if you had indeed been putting real objects in the list, you would still have had a bug, because you would first have freed them yourself without niling their references, so the string list's destructor would then try to "destroy" the things pointed to by these dangling pointers. Again, bad.