2019-09-06
Delphi 10.3 (v26.0) (2019)
在 Windows 10 x64 上測試，
若編譯的目的是 32-bit，則 64 位元的程序不會顯示出來
若編譯的目的是 64-bit，則 32、64 位元的程序會顯示出來，但不能在 Win32 上跑
參考
http://www.delphibasics.info/home/delphibasicssnippets/enumerateprocesses
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
PSAPI, TlHelp32, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetProcessName(PID: DWORD; var ProcessName: string): DWORD;
var
dwReturn : DWORD;
hProc : Cardinal;
buffer : array[0..MAX_PATH - 1] of Char;
begin
dwReturn := 0;
Zeromemory(@buffer, sizeof(buffer));
hProc := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, PID);
if hProc <> 0 then
begin
GetModulebaseName(hProc, 0, buffer, sizeof(buffer));
ProcessName := (string(buffer));
CloseHandle(hProc);
end
else
dwReturn := GetLastError;
result := dwReturn;
end;
type
TPIDList = array of DWORD;
function GetProcessList(var ProcessList: TPIDList): DWORD;
function GetOSVersionInfo(var Info: TOSVersionInfo): Boolean;
begin
FillChar(Info, SizeOf(TOSVersionInfo), 0);
Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
Result := GetVersionEx(TOSVersionInfo(Addr(Info)^));
if (not Result) then
begin
FillChar(Info, SizeOf(TOSVersionInfo), 0);
Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
Result := GetVersionEx(TOSVersionInfo(Addr(Info)^));
if (not Result) then
Info.dwOSVersionInfoSize := 0;
end;
end;
var
dwReturn : DWORD;
OS : TOSVersionInfo;
// EnumProcesses
PidProcesses : PDWORD;
PidWork : PDWORD;
BufferSize : Cardinal;
Needed : DWORD;
cntProcesses : Cardinal;
i : Cardinal;
// CreateToolhelp32Snapshot
hProcSnapShot: THandle;
pe32 : TProcessEntry32;
j : Cardinal;
begin
dwReturn := 0;
// What OS are we running on?
if GetOSVersionInfo(OS) then
begin
if (OS.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OS.dwMajorVersion = 4) then
// WinNT and higher
begin
Needed := 0;
BufferSize := 1024;
GetMem(PidProcesses, BufferSize);
// make sure memory is allocated
if Assigned(PidProcesses) then
begin
try
// enumerate the processes
if EnumProcesses(PidProcesses, BufferSize, Needed) then
begin
dwReturn := 0;
cntProcesses := Needed div sizeof(DWORD) - 1;
PidWork := PidProcesses;
setlength(ProcessList, cntProcesses);
// walk the processes
for i := 0 to cntProcesses - 1 do
begin
ProcessList[i] := PidWork^;
Inc(PidWork);
end;
end
else // EnumProcesses = False
dwReturn := GetLastError;
finally
// clean up no matter what happend
FreeMem(PidProcesses, BufferSize);
end;
end
else // GetMem = nil
dwReturn := GetLastError;
end
// Win 9x and higher except WinNT
else
begin
// make the snapshot
hProcSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hProcSnapShot <> INVALID_HANDLE_VALUE then
begin
pe32.dwSize := sizeof(TProcessEntry32);
j := 0;
setlength(ProcessList, j + 1);
if Process32First(hProcSnapShot, pe32) then
begin
// first process
ProcessList[j] := pe32.th32ProcessID;
// walk the processes
while Process32Next(hProcSnapShot, pe32) do
begin
Inc(j);
setlength(ProcessList, j + 1);
ProcessList[j] := pe32.th32ProcessID;
end;
end
else // Process32First = False
dwReturn := GetLastError;
CloseHandle(hProcSnapShot);
end
else // hSnapShot = INVALID_HANDLE_VALUE
dwReturn := GetLastError;
end;
end;
result := dwReturn;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
retValue : DWORD;
ProcessList : TPIDList;
i : Integer;
ProcessName : string;
PID : DWORD;
resourcestring
rsUnknown = 'unKnown';
begin
// VCL causes last error to be set, even nothing has already happend :-/
SetLastError(0);
retValue := GetProcessList(ProcessList);
if retValue = 0 then
begin
for i := 0 to length(ProcessList) - 1 do
begin
PID := ProcessList[i];
if GetProcessName(ProcessList[i], ProcessName) <> 0 then
begin
ProcessName := rsUnknown;
end
else
begin
// if LowerCase(ProcessName)='winword.exe' then
// begin
// Listbox1.Items.Add(IntToStr(PID) + ' - ' + ProcessName);
// end;
// if ProcessName<>'' then
// begin
// Listbox1.Items.Add(IntToStr(PID) + ' - ' + ProcessName);
// end;
end;
Listbox1.Items.Add(IntToStr(PID) + ' - ' + ProcessName);
end;
end
else
ShowMessage(SysErrorMessage(retValue));
end;
end.
|
(完)
沒有留言:
張貼留言