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;

Афоризм дня:
Кто не совершает несправедливости – почтенен; но более чем вдвое достоин почета тот, кто и другим не позволяет совершать несправедливости. (618)

Leave a reply

Яндекс.Метрика