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:
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:
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 nil
ing their references, so the string list's destructor would then try to "destroy" the things pointed to by these dangling pointers. Again, bad.