Вопрос # 2 027: …сперты!!! Доброго времени суток! Подскажите как мне узнать какие проц… (Взаимодействие с Windows)

Приветствую, уважаемые эксперты!!! Доброго времени суток!
Подскажите как мне узнать какие процессы запущены в системе(в том числе и системные), узнать от куда они запущены и вывести эту информацию в ListBox?
Заранее спасибо.

Здравствуйте, Фоминых Сергей Николаевич!
Посмотрите вот этот, замечательный пример.
https://www.delphi-int.ru/download/file/162/
Process Killers
Программа для завершения процессов. Показывает абсолютно всё запущеное на компьютере.
+ её исходник.

Здравствуйте, Фоминых Сергей Николаевич!
Держите в приложении несколько примерчиков:
1. Просмотрщик запущенных процессов;
2. Как получить список процессов;
3. Как определить какие приложения уже запущены;
4. Прочитать список всех запущенных Exe/ Проверить запущен ли Exe;
5. Как определить откуда был запущен процесс.

P.S. Желаю удачи.

Приложение:

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, tlhelp32, StdCtrls, ComCtrls, Buttons;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
Button4: TButton;
Button5: TButton;
StatusBar1: TStatusBar;
Button6: TButton;
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
procedure ListProcesses;
procedure Delproc(numb:string);
public
{ Public declarations }
end;
var
Form1: TForm1;
processID:array[1..50] of integer;
function RegisterServiceProcess(dwProcessID,dwType:integer):integer;stdcall;external 'kernel32.dll';
implementation
{$R *.DFM}
procedure TForm1.delproc(numb:string);
var
c1:Cardinal;
pe:TProcessEntry32;
s1,s2:string;
x:integer;
begin
x:=0;
try
Strtoint(numb);
except
Statusbar1.SimpleText:='Invalid number';
exit;
end;
c1:=CreateToolHelp32Snapshot(TH32CS_SnapProcess,0);
if c1=INVALID_HANDLE_VALUE then
begin
Statusbar1.SimpleText:='Process listing failed';
exit;
end;
try
pe.dwSize:=sizeof(pe);
if Process32First(c1,pe) then
repeat
inc(x);
s1:=ExtractFileName(pe.szExeFile);
s2:=ExtractFileExt(s1);
Delete(s1,length(s1)+1-length(s2),maxInt);
if x=strtoint(numb) then
if terminateprocess(OpenProcess(PROCESS_ALL_ACCESS,false,pe.th32ProcessID),1)
then begin
Statusbar1.SimpleText:='Process '+s1+' terminated.';
end
else Statusbar1.SimpleText:=('Couldnt terminate process'+pe.szExeFile);
until not Process32Next(c1,pe);
finally CloseHandle(c1);
end;
end;
procedure Tform1.ListProcesses;
var c1:Cardinal;
pe:TProcessEntry32;
s1,s2:string;
x:integer;
begin
X:=0;
c1:=CreateToolHelp32Snapshot(TH32CS_SnapProcess,0);
if c1=INVALID_HANDLE_VALUE then
begin
exit;
end;
try
pe.dwSize:=sizeof(pe);
if Process32First(c1,pe) then
repeat
inc(x);
s1:=ExtractFileName(pe.szExeFile);
s2:=ExtractFileExt(s1);
Delete(s1,length(s1)+1-length(s2),maxInt);
Listbox1.Items.Add(Inttostr(x)+' '+s1+' : '+pe.szExeFile);
ProcessId[x]:=pe.th32ProcessID;
//ListBox1.Items.Add(inttostr(pe.th32ProcessID));
until not Process32Next(c1,pe);
finally CloseHandle(c1);
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Enabled:=false;
Button5.Enabled:=false;
Button6.Enabled:=false;
ListProcesses;
if not (csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID,1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Listbox1.Clear;
ListProcesses;
end;
procedure TForm1.Button1Click(Sender: TObject);
var p:integer;
begin
//hide
with Listbox1 do
p:=Listbox1.Items.IndexOf(Listbox1.items[itemindex])+1;
if not (csDesigning in ComponentState) then
RegisterServiceProcess(ProcessID[p],1);
with Listbox1 do
StatusBar1.SimpleText:=(Listbox1.items[itemindex]+ ' hidden');
end;
procedure TForm1.Button5Click(Sender: TObject);
var p:integer;
begin
//show
with Listbox1 do
p:=Listbox1.Items.IndexOf(Listbox1.items[itemindex])+1;
if not (csDesigning in ComponentState) then
RegisterServiceProcess(ProcessID[p],0);
with Listbox1 do
StatusBar1.SimpleText:=(Listbox1.items[itemindex]+ ' shown');
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
Button1.Enabled:=true;
Button5.Enabled:=true;
Button6.Enabled:=true;
end;
procedure TForm1.Button6Click(Sender: TObject);
var p:integer;
begin
with Listbox1 do
p:=Listbox1.Items.IndexOf(Listbox1.items[itemindex])+1;
delproc(inttostr(p));
end;
end.
function IsRunning( sName : string ) : boolean;
var
han : THandle;
ProcStruct : PROCESSENTRY32; // from "tlhelp32" in uses clause
sID : string;
begin
Result := false;
// Get a snapshot of the system
han := CreateToolhelp32Snapshot( TH32CS_SNAPALL, 0 );
if han = 0 then
exit;
// Loop thru the processes until we find it or hit the end
ProcStruct.dwSize := sizeof( PROCESSENTRY32 );
if Process32First( han, ProcStruct ) then
begin
repeat
sID := ExtractFileName( ProcStruct.szExeFile );
// Check only against the portion of the name supplied, ignoring case
if uppercase( copy( sId, 1, length( sName ) ) ) = uppercase( sName ) then
begin
// Report we found it
Result := true;
Break;
end;
until not Process32Next( han, ProcStruct );
end;
// clean-up
CloseHandle( han );
end;
procedure TForm1.Button1Click(Sender: TObject);
VAR
Wnd : hWnd;
buff: ARRAY [0..127] OF Char;
begin
ListBox1.Clear;
Wnd := GetWindow(Handle, gw_HWndFirst);
WHILE Wnd <> 0 DO
THEN BEGIN
GetWindowText(Wnd, buff, sizeof(buff));
ListBox1.Items.Add(StrPas(buff));
END;
Wnd := GetWindow(Wnd, gw_hWndNext);
END;
ListBox1.ItemIndex := 0;
end;
uses
Psapi, tlhelp32;
procedure CreateWin9xProcessList(List: TstringList);
var
hSnapShot: THandle;
ProcInfo: TProcessEntry32;
begin
if List = nil then Exit;
hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapShot <> THandle(-1)) then
begin
ProcInfo.dwSize := SizeOf(ProcInfo);
if (Process32First(hSnapshot, ProcInfo)) then
begin
List.Add(ProcInfo.szExeFile);
while (Process32Next(hSnapShot, ProcInfo)) do
List.Add(ProcInfo.szExeFile);
end;
CloseHandle(hSnapShot);
end;
end;
procedure CreateWinNTProcessList(List: TstringList);
var
PIDArray: array [0..1023] of DWORD;
cb: DWORD;
I: Integer;
ProcCount: Integer;
hMod: HMODULE;
hProcess: THandle;
ModuleName: array [0..300] of Char;
begin
if List = nil then Exit;
EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
ProcCount := cb div SizeOf(DWORD);
for I := 0 to ProcCount - 1 do
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
PROCESS_VM_READ,
False,
PIDArray[I]);
if (hProcess <> 0) then
begin
EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);
GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));
List.Add(ModuleName);
CloseHandle(hProcess);
end;
end;
end;
procedure GetProcessList(var List: TstringList);
var
ovi: TOSVersionInfo;
begin
if List = nil then Exit;
ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(ovi);
case ovi.dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(List);
VER_PLATFORM_WIN32_NT: CreateWinNTProcessList(List);
end
end;
function EXE_Running(FileName: string; bFullpath: Boolean): Boolean;
var
i: Integer;
MyProcList: TstringList;
begin
MyProcList := TStringList.Create;
try
GetProcessList(MyProcList);
Result := False;
if MyProcList = nil then Exit;
for i := 0 to MyProcList.Count - 1 do
begin
if not bFullpath then
begin
if CompareText(ExtractFileName(MyProcList.Strings[i]), FileName) = 0 then
Result := True
end
else if CompareText(MyProcList.strings[i], FileName) = 0 then Result := True;
if Result then Break;
end;
finally
MyProcList.Free;
end;
end;
// Example 1: Is a Exe-File running ?
procedure TForm1.Button1Click(Sender: TObject);
begin
if EXE_Running('Notepad.exe', False) then
ShowMessage('EXE is running')
else
ShowMessage('EXE is not running');
end;
// Example 2: List running Exe-Files
procedure TForm1.Button3Click(Sender: TObject);
var
i: Integer;
MyProcList: TstringList;
begin
MyProcList := TStringList.Create;
try
GetProcessList(MyProcList);
if MyProcList = nil then Exit;
for i := 0 to MyProcList.Count - 1 do
ListBox1.Items.Add(MyProcList.Strings[i]);
finally
MyProcList.Free;
end;
end;
uses
tlhelp32;
type
TModuleArray = array of TModuleEntry32;
function GetModulesListByProcessId(ProcessId : Cardinal) : TModuleArray;
implementation
function GetModulesListByProcessId(ProcessId : Cardinal) : TModuleArray;
var
hSnapshot : THandle;
lpme : TModuleEntry32;
procedure AddModuleToList;
begin
SetLength(Result,High(Result)+2);
Result[high(Result)]:=lpme;
end;
begin
SetLength(Result,0);
hSnapshot:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,ProcessId);
if hSnapshot=-1 then RaiseLastWin32Error;
lpme.dwSize:=SizeOf(lpme);
if Module32First(hSnapshot,lpme) then
begin
AddModuleToList;
while Module32Next(hSnapshot,lpme) do AddModuleToList;
end;
end;
VAR Wnd : hWnd;
buff: ARRAY [0..127] OF Char;
//------------------------------------
Pid : Cardinal;
modarr : TModuleArray;
Name : String;
//------------------------------------
begin
StringGrid1.RowCount:=1;
Wnd := GetWindow(Handle, gw_HWndFirst);
WHILE Wnd <> 0 DO
BEGIN
IF (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) THEN
BEGIN
fillchar(name,sizeof(name),#0);
GetWindowText(wnd,buff,sizeof(buff));
// if getmodulefilename(GetWindowLong(wnd,GWL_HINSTANCE),name,sizeof(name))=0
// then name:='Null';
//-----------------------------------------
GetWindowThreadProcessId(Wnd,@Pid);
modarr:=GetModulesListByProcessId(Pid);
name:='Null';
for i:=0 to High(modarr) do
begin
if Integer(modarr[i].modBaseAddr)=$400000 then
begin
name:=modarr[i].szExePath;
break;
end;
end;
//-----------------------------------------
StringGrid1.Cells[0,StringGrid1.RowCount-1]:=StrPas(buff);
StringGrid1.Cells[1,StringGrid1.RowCount-1]:=StrPas(name);
StringGrid1.RowCount:=StringGrid1.RowCount+1;
END;
Wnd := GetWindow(Wnd, gw_hWndNext);
END;
StringGrid1.RowCount:=StringGrid1.RowCount-1;
end;

Здравствуйте, Фоминых Сергей Николаевич!
Вот пример кода

Приложение:

uses
Psapi, tlhelp32;
procedure CreateWin9xProcessList(List: TstringList);
var
hSnapShot: THandle;
ProcInfo: TProcessEntry32;
begin
if List = nil then Exit;
hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapShot <> THandle(-1)) then
begin
ProcInfo.dwSize := SizeOf(ProcInfo);
if (Process32First(hSnapshot, ProcInfo)) then
begin
List.Add(ProcInfo.szExeFile);
while (Process32Next(hSnapShot, ProcInfo)) do
List.Add(ProcInfo.szExeFile);
end;
CloseHandle(hSnapShot);
end;
end;
procedure CreateWinNTProcessList(List: TstringList);
var
PIDArray: array [0..1023] of DWORD;
cb: DWORD;
I: Integer;
ProcCount: Integer;
hMod: HMODULE;
hProcess: THandle;
ModuleName: array [0..300] of Char;
begin
if List = nil then Exit;
EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);
ProcCount := cb div SizeOf(DWORD);
for I := 0 to ProcCount - 1 do
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
PROCESS_VM_READ,
False,
PIDArray[I]);
if (hProcess <> 0) then
begin
EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);
GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));
List.Add(ModuleName);
CloseHandle(hProcess);
end;
end;
end;
procedure GetProcessList(var List: TstringList);
var
ovi: TOSVersionInfo;
begin
if List = nil then Exit;
ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(ovi);
case ovi.dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(List);
VER_PLATFORM_WIN32_NT: CreateWinNTProcessList(List);
end
end;
function EXE_Running(FileName: string; bFullpath: Boolean): Boolean;
var
i: Integer;
MyProcList: TstringList;
begin
MyProcList := TStringList.Create;
try
GetProcessList(MyProcList);
Result := False;
if MyProcList = nil then Exit;
for i := 0 to MyProcList.Count - 1 do
begin
if not bFullpath then
begin
if CompareText(ExtractFileName(MyProcList.Strings[i]), FileName) = 0 then
Result := True
end
else if CompareText(MyProcList.strings[i], FileName) = 0 then Result := True;
if Result then Break;
end;
finally
MyProcList.Free;
end;
end;
// Example 1: Is a Exe-File running ?
procedure TForm1.Button1Click(Sender: TObject);
begin
if EXE_Running('Notepad.exe', False) then
ShowMessage('EXE is running')
else
ShowMessage('EXE is not running');
end;
// Example 2: List running Exe-Files
procedure TForm1.Button3Click(Sender: TObject);
var
i: Integer;
MyProcList: TstringList;
begin
MyProcList := TStringList.Create;
try
GetProcessList(MyProcList);
if MyProcList = nil then Exit;
for i := 0 to MyProcList.Count - 1 do
ListBox1.Items.Add(MyProcList.Strings[i]);
finally
MyProcList.Free;
end;
end;

Мини-форум вопроса

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 2 027

Мини-форум вопроса

Экспертная система Delphi.int.ru

Сообщество программистовОбщение, помощь, обмен опытом

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

Статистика за сегодня:

Лучшие эксперты

Вопрос # 2 027

Мини-форум вопроса

Сообщество программистов
Общение, помощь, обмен опытом