Windows
Как в Delphi получить PID процесса по заголовку его окна?
{***********************************************************
Алгоритм работы поиска PID по заголовку окна.
1 Получаем список всех процессов фильтруя по названию EXE-файла.
2 Получаем список открытых окон процесса
3 Перебираем все заголовки окна и сравниваем с искомым
Если совапало - сохраняем PID в переменную.
***********************************************************}
uses
TLHelp32;
type
TPF = class(TForm)
procedure BtnRefreshClick(Sender: TObject);
procedure FillProcessList;
procedure GetTopWindows(PID: Cardinal);
var
MainExeProcessNameToSearch: string;
CaptionTextForSearch: string;
WordProcessPIDAlreadyFinded: boolean;
WinProcessPID: string;
procedure TPF.FormCreate(Sender: TObject);
begin
MainExeProcessNameToSearch:='WINWORD.EXE';
CaptionTextForSearch:=Word.Caption;
WordProcessPIDAlreadyFinded:= False;
FillProcessList;
end;
procedure TPF.FillProcessList;
var
SnapProc: THandle;
ProcEntry: TProcessEntry32;
Item: TListItem;
begin
// Создаём снимок, в котором сохраняем все процессы, а
// затем в цикле получаем информацию о каждом из этих
// процессов, перенося её в ListProcesses
SnapProc := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if SnapProc <> INVALID_HANDLE_VALUE then
try
ProcEntry.dwSize := SizeOf(TProcessEntry32);
if Process32First(SnapProc, ProcEntry) then
repeat
//Если название процесса не равено "WINWORD.EXE" тогда продолжим перебор и перейдем к следующему процессу
if (ProcEntry.szExeFile <> MainExeProcessNameToSearch) then continue;
Item := ListProcesses.Items.Add;
Item.Caption := ProcEntry.szExeFile;
Item.SubItems.Add(IntToStr(ProcEntry.th32ProcessID));
Item.SubItems.Add(IntToStr(ProcEntry.th32ParentProcessID));
Item.SubItems.Add(IntToStr(ProcEntry.cntThreads));
// Сохраняем PID в поле Data соответствующего
// элемента списка. Вообще, поле Data имеет тип
// Pointer, а PID - это целое число, но т.к. оба этих
// типа 32-битные, их можно приводить друг к другу
Item.Data := Pointer(ProcEntry.th32ProcessID);
if (BoolToStr(WordProcessPIDAlreadyFinded,true)='False') then
GetTopWindows(ProcEntry.th32ProcessID);;//case False
until not Process32Next(SnapProc, ProcEntry);
finally
CloseHandle(SnapProc);
end
end;
//заполняем окна процесса windows process
function SearchPidByCaption(Wnd: HWnd; PIDNeeded: Cardinal): Bool; stdcall;
var
Text: string;
TextLen: Integer;
WndPID: Cardinal;
Label9: TLabel;
begin
Result := True;
if BoolToStr(WordProcessPIDAlreadyFinded,true)='True' then Exit;//Завершим цикл в случае когда PID уже был найден;
// Здесь отсеиваются окна, которые не принадлежат
// выбранному процессу
GetWindowThreadProcessID(Wnd, @WndPID);
if WndPID = PIDNeeded then
begin
TextLen := GetWindowTextLength(Wnd);
SetLength(Text, TextLen);
if TextLen > 0 then
GetWindowText(Wnd, PChar(Text), TextLen + 1);
if TextLen > 100 then
Text := Copy(Text, 1, 100) + ' ...';
if (Text = CaptionTextForSearch) then
begin
WordProcessPIDAlreadyFinded:= True;
WinProcessPID:= IntToStr(WndPID);
Label9.Caption:= Text + IntToStr(WndPID)+ BoolToStr(WordProcessPIDAlreadyFinded,true);
//ProcessesInfoForm.Memo1.text:= ' OK '+IntToStr(WndPID)+ BoolToStr(WordProcessPIDAlreadyFinded);
end
end
else
begin
WinProcessPID:= 'По заголовку "'+CaptionTextForSearch+'" pid Не найден ';
Label9.Caption:= 'По заголовку "'+CaptionTextForSearch+'" pid Не найден ';
end;;
end;
procedure TPF.GetTopWindows(PID: Cardinal);
begin
if PID = 0 then
Exit;
//Если искомый PID процесса еще не найдет тогда запустим функцию перебора окон
if (BoolToStr(WordProcessPIDAlreadyFinded,true)='False') then
EnumWindows(@SearchPidByCaption, PID);//case False
end;
procedure TPF.BtnRefreshClick(Sender: TObject);
begin
FillProcessList;
end;
Комментарии по функциям WinAPI:
1. получение "моментального снимка всех процессов" (дескриптор снимка):
FSnap:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
2. По списку процессов можно «пробежаться» с помощью функций Process32First и Process32Next.
Сначала вызывается Process32First, а затем для каждого последующего процесса - Process32Next. Когда процессы для перечисления заканчиваются Process32Next возвращает False.
3. Функция EnumWindows перечисляет все окна верхнего уровня, передавая текущий описатель окна Callback функции, определенной в приложении.
delphi Ошибка access violation
бывает когда происходит попытка обратиться к объекту который еще не инициализирован
Как в Delphi получить список процессов и их PID?
Тестировалось на Embarcadero 10.3
uses TLHelp32;
procedure TForm1.Button1Click(Sender: TObject);
var
MyHandle: THandle;
Struct: TProcessEntry32;
begin
try
MyHandle:=CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
Struct.dwSize:=Sizeof(TProcessEntry32);
if Process32First(MyHandle, Struct) then
ListBox1.Items.Add(Struct.szExeFile);
while Process32Next(MyHandle, Struct) do
ListBox1.Items.Add(Struct.szExeFile + ' - '+IntToStr(Struct.th32ProcessID));
except on exception do
ShowMessage('Error showing process list');
end
end;
end.
Как сохранить текст в файл Delphi?
1 Через поле memo, с процедурой от кнопки:
procedure TForm1.SaveButtonClick(Sender : TObject); Begin Memo1.Lines.SaveToFile('File name'); End;
2 или через диалоги:
procedure TForm1.SaveButtonClick(Sender : TObject); Begin SaveDialog1.Execute; Edit1.Text:=SaveDialog1.FileName; Memo1.Lines.SaveToFile(Edit1.Text); End;
3 или через объект TStringList:
procedure TPF.Button1Click(Sender: TObject); var writer : TStringList; testFileName: string; begin writer:=TStringList.Create; writer.Add('string1=' + 'string1 value'); writer.Add('string2=' + 'string2 value');
testFileName:= Application.ExeName;
testFileName:= ExtractFileName(testFileName);
testFileName:= StringReplace(testFileName, '.exe', '.test', [rfReplaceAll, rfIgnoreCase]);
writer.SaveToFile(testFileName);
ShowMessage('Сохранено.');
end;
Leave a reply