[DarkSmile]

Здравствуйте! Написал следующий код для нахождения процесса:

Код:

Function PId(Exename:string):Dword;
var snap:DWORD;
 pe:TprocessEntry32;
begin
 result:=0;
 snap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
 if snap <>INVALID_HANDLE_VALUE then begin
   pe.dwSize:=sizeof(TPROCESSENTRY32);
 if process32First(snap,pe) then
repeat
 if pe.szExeFile=exename then begin
   result:=pe.th32ProcessID;
   closehandle(snap);
   exit;
 end;
until not process32Next(snap,pe);
 closehandle(snap);
 result:=0;
 end;
end;

function OpenProc(id:integer):boolean;
var
hProcess:THandle;
begin
     hProcess:=OpenProcess(PROCESS_ALL_ACCESS,false,id);
     if hProcess = 0 then  begin
       ShowMessage('Процесс не найден');
     end else
       ShowMessage('Процесс ok!');
end;

Код:

procedure TForm1.Button1Click(Sender: TObject);
begin
    OpenProc(PId('calc.exe'))
end;

На Windows 7 все работает отлично, но на Windows XP почему то не находит процесс. Точнее я знаю почему, типа xp не дружит с PROCESS_ALL_ACCESS, но не знаю как можно это исправить, подскажите пожалуйста)

[angvelem]

И XP также работает.

[DarkSmile]

А все понял. Вот есть такой код поиска всех запусщеных процессов:

Код:

procedure GetProcessList(var sl: TStrings);
var
  pe: TProcessEntry32;
  ph, snap: THandle; //дескрипторы процесса и снимка
  mh: hmodule; //дескриптор модуля
  procs: array[0..$FFF] of dword; //массив для хранения дескрипторов процессов
  count, cm: cardinal; //количество процессов
  i: integer;
  ModName: array[0..max_path] of char; //имя модуля
  Wnd : hWnd;
  buff: array[0..$FFF] of char;
begin
  sl.Clear;
  if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
  begin //если это Win9x
    snap := CreateToolhelp32Snapshot(th32cs_snapprocess, 0);
    if integer(snap) = -1 then
    begin
      exit;
    end
    else
    begin
      pe.dwSize := sizeof(pe);
      if Process32First(snap, pe) then
        repeat
          sl.Add(string(pe.szExeFile));

        until not Process32Next(snap, pe);
    end;
  end
  else
  begin //Если WinNT/2000/XP
    if not EnumProcesses(@procs, sizeof(procs), count) then
    begin
      exit;
    end;
    for i := 0 to count div 4 - 1 do
    begin
      ph := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
        false, procs[i]);
      if ph > 0 then
      begin
        EnumProcessModules(ph, @mh, 4, cm);
        GetModuleFileNameEx(ph, mh, ModName, sizeof(ModName));
        sl.Add(ExtractFileName(string(ModName)); 
        CloseHandle(ph);
      end;
    end;
  end;
end;

И такой код поиска заголовка активных окон:

Код:

Form6.ListBox1.Clear;
          // Получаем hWnd первого окна
          Wnd := GetWindow(Form6.Handle, gw_HWndFirst);
          // Цикл поиска окон
          WHILE Wnd <> 0 DO BEGIN
            IF (Wnd <> Application.Handle) AND // -Собственное окно
               IsWindowVisible(Wnd) AND             // -Невидимые окна
               (GetWindow(Wnd, gw_Owner) = 0) AND   // -Дочернии окна
               (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) // -Окна без заголовков
            THEN BEGIN
              GetWindowText(Wnd, buff, sizeof(buff));
              Form6.ListBox1.Items.Add(StrPas(buff));
            END;
            // Ищем новое окно
            Wnd := GetWindow(Wnd, gw_hWndNext);
          END;
          Form6.ListBox1.ItemIndex := 0;

Как можно их вместе соединить что-бы получить результат типа такого "calc.exe -- Калькулятор" ? И выводить это все комбобокс

[UFO 007]

Осмелюсь предложить - что-то - где-то - как-то так:

Код:

Function PId(Exename:string):Dword;
var
  snap:DWORD;
  pe:TprocessEntry32;
  Wnd : hWnd;
  buff: array[0..Max_Path] of char;
  tmpPID: DWord;
begin
  result:= 0;
  snap:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  if snap <> INVALID_HANDLE_VALUE then
  begin
    pe.dwSize:= sizeof(TPROCESSENTRY32);
    if process32First(snap, pe) then
    repeat
      Wnd := GetWindow(Application.Handle, gw_HWndFirst);
      WHILE Wnd <> 0 DO
      BEGIN // Цикл поиска окон
        IF (Wnd <> Application.Handle) AND   // -Собственное окно
           IsWindowVisible(Wnd) AND          // -Невидимые окна
           (GetWindow(Wnd, gw_Owner) = 0) AND// -Дочерние окна
           (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) // -Окна без заголовков
        THEN
        BEGIN
          GetWindowText(Wnd, buff, sizeof(buff));
          GetWindowThreadProcessId(Wnd,  @tmpPID);
          If tmpPID = pe.th32ProcessID then
form1.Memo1.Lines.Add(pe.szExeFile + ' = ' + StrPas(buff));
        END;
        Wnd := GetWindow(Wnd, gw_hWndNext); // Ищем новое окно
      END;
      if CompareText(pe.szExeFile, exename) = 0 then
      begin
        result:= pe.th32ProcessID;
        closehandle(snap);
        exit;
      end;
    until not process32Next(snap,pe);
    closehandle(snap);
    result:= 0;
  end;
end;

а следующую ф-цию я подправил так:
function OpenProc(id: Cardinal):boolean;

[UFO 007]

З. Ы. Ай Эм Вэри Сорри за полугодовую задержку (до этого как-то не требовалось то, через что Гугл ткнул меня в эту тему, да и Автор за это время мож нашёл более грациозное решение своей задачи [к стати - не отписался]) и прошу: казнить нельзя - помиловать (мабудь моя "стряпня" кому-нить из новичков типа меня или Автора [темы] на чё-нить, да сгодится...)

P. P. S. И самое парадоксальное:

Сообщение от angvelem

И XP также работает.

- из-под ХР_х86 в D7 - сработало, но только для calc.exe, а как только приторочил ф-ции из 1-го поста для такой серъёзной вещи как MoveProcessMemoryToFile {Автор: Человек_Борща & mss & GunSmoker} - упиралось до последнего, пока не поправил "зелёным" (что постом выше), а др. гипотеза - клиент так защищён, что пришлось перед

Сообщение от Автор: Человек_Борща & mss & GunSmoker

Код:

...
          //Если страница памяти доступна и не заблокирована для нас
          if ((MBI.State = MEM_COMMIT) and (not (MBI.Protect = PAGE_GUARD) or (MBI.Protect =  PAGE_NOACCESS))) then
...

добавить

Код:

     VirtualProtect(Pointer(BaseAddr), SizeOf(MBI), PAGE_EXECUTE_READWRITE, OldPageProtection);

тут уж сорри за нарушение авторских прав, но не удержался (точнее - ощущав остру необхидность)... И не мытьём - так катаньем : дамп клиента я сбросил в файл (за что отдельное спасибо ЧеловекУ_Борща & mssУ & GunSmokerУ унд Зер Гроссе Еншульдиген Зи Битте - ведь выходит: вродь как оскорбил авторов своей доработкой)...