Delphi как найти процесса

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

local ProcessNames := {
 
"Tutorial-i386",
"Tutorial-x86_64.exe",
}
 
local attachToProcess := false
 
for i := 1, #ProcessNames do
if getProcessIDFromProcessName(ProcessNames[i]) ~= nil then
 
attachToProcess := true
Form1.Label1.Font.Color := 0x00FFFF80;
 
else
 
if not attachToProcess then
Form1.Label1.Font.Color := 0x000202FF;
 
end;

1

getProcessIDFromProcessName

1
2
3
4
5
6
7
8
9
10
11
12
13

procedure TForm1.Button1Click(Sender: TObject); 
const 
  SCRIPT_STRING =  
  'Form1 {Caption="Text", Position=poScreenCenter, Color=0x007F7F7F}'; 
var 
  Lua: TLua; 
begin 
  Lua := TLua.Create; 
  Lua.RegClass(TForm1); 
  Lua.RegVariable('Form1', Form1, typeinfo(TForm1)); 
  Lua.RunScript(SCRIPT_STRING);  
  Lua.Free; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112

unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, tlhelp32, Vcl.StdCtrls, Vcl.ExtCtrls, PsApi, ShellAPI,
  Vcl.ComCtrls;
 
type
  TForm1 = class(TForm)
    ProcName: TLabel;
    FindPathProcBtn: TButton;
    PIDBox: TEdit;
    PIDLB: TLabel;
    MSGPNL: TPanel;
    ProcBox: TComboBox;
    procedure FindPathProcBtnClick(Sender: TObject);
    procedure MSGPNLClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ProcBoxChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
 
implementation
 
{$R *.dfm}
 
 
type
  TMArray = array of TModuleEntry32;
 
 // Функция для получения PID из запущенного в ОС процесса
function GetPathFromPID(const PID: cardinal): string;
var
  hProcess: THandle;
  path: array[0..MAX_PATH - 1] of char;
begin
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, PID);
  if hProcess <> 0 then
    try
      if GetModuleFileNameEx(hProcess, 0, path, MAX_PATH) = 0 then
        result:='Null';
      result := path;
    finally
      CloseHandle(hProcess)
    end
  else
    // Если произойдёт исключение и процесс не будет найден
    // приложение предупредит об этом
    result:='Процесс с указанным PID в системе не запущен';
end;
 
   // Выводим путь к запущенному процессу на информационную панель
procedure TForm1.FindPathProcBtnClick(Sender: TObject);
begin
  MSGPNL.Caption:= GetPathFromPID(StrToInt(PIDBox.text));
end;
 
   // Процедура отображения PID выбранного процесса,
   // из списка запущенных в системе на информационной панели
procedure TForm1.ProcBoxChange(Sender: TObject);
 var
  hSnap:THandle;
  pe:TProcessEntry32;
begin
 pe.dwSize:=SizeOf(pe);
 hSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  If Process32First(hSnap,pe) then
    While Process32Next(hSnap,pe) do
      if ExtractFileName(pe.szExeFile)=(ProcBox.text) then PIDBox.text:=(IntToStr(pe.th32ProcessID));
        // Меняем цвет информационной панель на зеленый
        MSGPNL.Font.Color:= clGreen;
        // Выводим информационное сообщение о PID выбранного процесса на панель
        MSGPNL.Caption:=('PID запущенного процесса ' + (ProcBox.text) +' - ' + (PIDBox.text));
end;
 
  //Процедура получения списка запущенных в ОС процессов и загрузка их
  //ProcBox, в котором их можно будет выбирать
procedure TForm1.FormCreate(Sender: TObject);
  var
  hSnap :THandle;
  pe:TProcessEntry32;
begin
  pe.dwSize:=SizeOf(pe);
  hSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  if Process32First(hSnap,pe) then
    repeat
      ProcBox.Items.Add(pe.szExeFile);
    until not(Process32Next(hSnap,pe));
    // Выводим первый индекс из списка полученных процессов в ProcBox
      ProcBox.ItemIndex:= 1 ;
end;
 
  // Процедура для открытия папки с EXE-файлом выбранного в ProcBox процесса
procedure TForm1.MSGPNLClick(Sender: TObject);
var
Dir, Path : String;
  begin
  Path := MSGPNL.Caption; //полный путь к файлу
  Dir := ExtractFilePath(Path);//путь к папке
  ShellExecute(Handle, 'open', PWideChar(Dir), nil, nil, SW_SHOWNORMAL); //открываем папку
end;
 
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

procedure TForm1.Timer1Timer(Sender: TObject);
begin
local ProcessNames := {
 
"Tutorial-i386",
"Tutorial-x86_64.exe",
}
 
local attachToProcess := false
 
for i := 1, #ProcessNames do
if getProcessIDFromProcessName(ProcessNames[i]) ~= nil then
 
attachToProcess := true
Form1.Label1.Font.Color := 0x00FFFF80;
 
else
 
if not attachToProcess then
Form1.Label1.Font.Color := 0x000202FF;
 
end;

1
2
3
4
5
6
7
8
9
10
11
12

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   local ProcessNames := { "Tutorial-i386", "Tutorial-x86_64.exe", }
      local attachToProcess := false
            for i := 1, #ProcessNames do
                  if getProcessIDFromProcessName(ProcessNames[i]) ~= nil then
                        attachToProcess := true
                        Form1.Label1.Font.Color := 0x00FFFF80;
                        else
                  if not attachToProcess then
                        Form1.Label1.Font.Color := 0x000202FF;
 end;

1

local ProcessNames := { "Tutorial-i386", "Tutorial-x86_64.exe", }

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

[B]function CETimer1Timer(sender) -- Этот таймер находил открытый процесс Tutorial-i386.exe этой программы Tutorial-i386
 
local ProcessNames = {
 
"Tutorial-i386.exe", -------вот это имя процесса которое находилось при открытии программы Tutorial-i386
"Tutorial-x86_64.exe",  ------ или вот это имя процесса находилась при открытии этой программы Tutorial-x86_64
}
local attachToProcess = false
 
for i = 1, #ProcessNames do
if getProcessIDFromProcessName(ProcessNames[i]) ~= nil then
 
attachToProcess = true
UDF1.CELabel1.Font.Color = 0x00FFFF80----меняет цвет имя процесса вEdit1
UDF1.CEEdit1.Text = ProcessNames[i] ---выводит имя найденного процесса открытой программы в Edit1 и показывает его.
 
else
 
if not attachToProcess then
UDF1.CELabel1.Font.Color = 0x000202FF -- меняет цвет имя процесса в Edit1 при закрытии программы с её процессом
UDF1.CEEdi1.Text = ""  ------- При закрытии процесса Tutorial-i386.exe имя этого процесса исчезало из Edit1
 
end[/B]

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, tlhelp32, ExtCtrls, StdCtrls, Spin;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Timer1: TTimer;
    SpinEdit1: TSpinEdit;
    Button1: TButton;
    Label2: TLabel;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
// Функция поиска запущенного процесса
function IsRunning(sName: string): boolean;
var
  han: THandle;
  ProcStruct: PROCESSENTRY32;
  sID: string;
begin
  Result := false;
 
  han := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  if han = 0 then
    exit;
 
  ProcStruct.dwSize := sizeof(PROCESSENTRY32);
  if Process32First(han, ProcStruct) then
  begin
    repeat
      sID := ExtractFileName(ProcStruct.szExeFile);
 
      if uppercase(copy(sID, 1, length(sName))) = uppercase(sName) then
      begin
 
        Result := true;
        Break;
      end;
    until not Process32Next(han, ProcStruct);
  end;
 
  CloseHandle(han);
end;
 
// Таймер для проверки запущен процесс или нет
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // Проверяем запущен ли процесс
  timer1.Interval := StrToInt(SpinEdit1.Text);
  // Если запущен то:
  if IsRunning('Tutorial-i386.exe') then
  begin
    //то выводим имя процесса
    Edit1.Text := ('Tutorial-i386.exe');
    //делаем его цветом морской волны (близкий значению цвета 0x00FFFF80, указанному Вами в скрипте)
    Edit1.Font.Color := clAqua;
  end
  // Если не запущен то:
  else
  begin
    //делаем его красным цветом (близкий значению цвета 0x000202FF, указанному Вами в скрипте)
    //бред полный, ТАК ДЕЛАТЬ НЕ НУЖНО!!!
    Edit1.Font.Color := clRed;
    //очищаем поле где находился процесс
    Edit1.Text := ('');
  end;
 
end;
 
//Запускаем таймер
procedure TForm1.Button1Click(Sender: TObject);
begin
  timer1.Enabled := True;
end;
 
//Останавливаем таймер, очищаем Edit1
procedure TForm1.Button2Click(Sender: TObject);
begin
  timer1.Enabled := False;
  Edit1.Text := '';
end;
 
//Закрываем приложение
procedure TForm1.Button3Click(Sender: TObject);
begin
  Close;
end;
 
end.

1
2

UDF1.CELabel1.Font.Color = 0x000202FF -- меняет цвет имя процесса в Edit1 при закрытии программы с её процессом
UDF1.CEEdi1.Text = ""  ------- При закрытии процесса Tutorial-i386.exe имя этого процесса исчезало из Edit1

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, tlhelp32, ExtCtrls, StdCtrls, Spin;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Timer1: TTimer;
    SpinEdit1: TSpinEdit;
    Button1: TButton;
    Label2: TLabel;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
// Функция поиска запущенного процесса
function IsRunning(sName: string): boolean;
var
  han: THandle;
  ProcStruct: PROCESSENTRY32;
  sID: string;
begin
  Result := false;
 
  han := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  if han = 0 then
    exit;
 
  ProcStruct.dwSize := sizeof(PROCESSENTRY32);
  if Process32First(han, ProcStruct) then
  begin
    repeat
      sID := ExtractFileName(ProcStruct.szExeFile);
 
      if uppercase(copy(sID, 1, length(sName))) = uppercase(sName) then
      begin
 
        Result := true;
        Break;
      end;
    until not Process32Next(han, ProcStruct);
  end;
 
  CloseHandle(han);
end;
 
// Таймер для проверки запущен процесс или нет
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // Проверяем запущен ли процесс
  timer1.Interval := StrToInt(SpinEdit1.Text);
  // Если запущен то:
  if IsRunning('Tutorial-i386.exe') then
  begin
    //то выводим имя процесса
    Edit1.Text := ('Tutorial-i386.exe');
    //делаем форму цветом морской волны
    Form1.Color := clAqua;
  end
  // Если не запущен то:
  else
  begin
     //Сообщаем о том что процесс не запущен в ОС
     Edit1.Text := ('Процесс не запущен!');
     //делаем форму красным цветом
     Form1.Color := clRed;
  end;
 
end;
 
//Запускаем таймер
procedure TForm1.Button1Click(Sender: TObject);
begin
  timer1.Enabled := True;
end;
 
//Останавливаем таймер, очищаем Edit1
procedure TForm1.Button2Click(Sender: TObject);
begin
  timer1.Enabled := False;
  Edit1.Text := '';
end;
 
//Закрываем приложение
procedure TForm1.Button3Click(Sender: TObject);
begin
  Close;
end;
 
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

function IsRunning(sName: string): boolean;
var
  han: THandle;
  ProcStruct: PROCESSENTRY32;
  sID: string;
begin
  Result := false;
 
  han := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  if han = 0 then
    exit;
 
  ProcStruct.dwSize := sizeof(PROCESSENTRY32);
  if Process32First(han, ProcStruct) then
  begin
    repeat
      sID := ExtractFileName(ProcStruct.szExeFile);
 
      if uppercase(copy(sID, 1, length(sName))) = uppercase(sName) then
      begin
 
        Result := true;
        Break;
      end;
    until not Process32Next(han, ProcStruct);
  end;
 
  CloseHandle(han);
end;

1
2
3

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, [B]tlhelp32[/B], ExtCtrls, StdCtrls, Spin;