uses Tlhelp32, PsAPI;
var
ProcArr: array of TProcessEntry32;
ColumnToSort: Integer;
procedure EnumProcess(pNameList, PidList: TStrings);
var
hProcess: THandle;
Find: Boolean;
Proc: TProcessEntry32;
i: DWORD;
begin
try
hProcess := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
Proc.dwSize := SizeOf(Proc);
Find := Process32First(hProcess, Proc);
i := 0;
while Find do
begin
SetLength(ProcArr, i + 1);
ProcArr[i] := Proc;
inc(i);
pNameList.Add(Proc.szExeFile);
PidList.Add(inttostr(Proc.th32ProcessID));
Find := Process32Next(hProcess, Proc);
end;
finally
CloseHandle(hProcess);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
PnList, PidList: TStringList;
i, d, lpc: DWORD;
hProc: THandle;
hModu: HMODULE;
cb: Cardinal;
exeName: array[0..MAX_PATH] of Char;
item: TListItem;
begin
lv1.Clear;
try
d := 1;
PnList := TStringList.Create;
PidList := TStringList.Create;
PnList.Clear;
PidList.Clear;
EnumProcess(PnList, PidList);
for i := Low(ProcArr) to High(ProcArr) do
begin
Item := lv1.Items.Add;
item.Caption := IntToStr(d);
item.SubItems.Add(ProcArr[i].szExeFile);
item.SubItems.Add(IntToStr(ProcArr[i].th32ProcessID));
hProc := OpenProcess(PROCESS_QUERY_INFORMATION
or PROCESS_VM_READ, False, ProcArr[i].th32ProcessID);
if hProc > 0 then
begin
EnumProcessModules(hProc, @hModu, SizeOf(hModu), Lpc);
if GetModuleFileNameEx(hProc, hModu, exeName, SizeOf(exeName)) > 0 then
item.SubItems.Add(ExtractFileDir(exeName) + exeName);
end;
inc(D);
end;
stat1.Panels[0].Text := Format('当前系统共有 %D 个进程', [D - 1]);
finally
FreeAndNil(PnList);
FreeAndNil(PidList);
CloseHandle(Hproc);
end;
end;
procedure TForm1.lv1ColumnClick(Sender: TObject; Column: TListColumn); //排序
begin
ColumnToSort := Column.Index;
(Sender as TCustomListView).AlphaSort;
end;
procedure TForm1.lv1Compare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
var
ix: Integer;
begin
try
if ColumnToSort = 0 then
Compare := CompareText(Item1.Caption, Item2.Caption) //排序
else
begin
ix := ColumnToSort - 1;
Compare := CompareText(Item1.SubItems[ix], Item2.SubItems[ix]);
end;
except
//Beep;
//Exit;
end;
end;
获取进程路径
最新推荐文章于 2023-12-06 23:39:54 发布