VPF::Список процессов - Форум программистов

E_v_g

Дата 14.3.2007, 13:53 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 76
Регистрация: 15.11.2006

Репутация: нет
Всего: нет

Вопрос: как получить список процессов? Для Win XP работает, а вот в Win NT не хочет. smile

Код такой:

Код



procedure GetProcList(Socket: TCustomWinSocket);
var
  c1 : Cardinal;
  pe : TProcessEntry32;
  s1,s2 : string;
  x : integer;
  s : string;
  processID:array[1..50] of integer;
begin
  s := '';
  X := 0;
  c1:=CreateToolHelp32Snapshot(TH32CS_SnapProcess,0);
  if c1 = INVALID_HANDLE_VALUE then
    begin
      Socket.SendText('message'#13'Cannot get process list' + #0);
      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);
        s := s + IntToStr(pe.th32ProcessID) +'='+ {Inttostr(x)+'  '+s1+'  :  '+}pe.szExeFile + #13;
        //  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;
  Socket.SendText('get app list'#13 + s + #0);
end;

Есть ли универсальный способ получить список процессов?

Yanis

Дата 14.3.2007, 15:00 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 13
Всего: 111

E_v_g
В NT, когда тестишь программу, то при её работе выводится ссообщение "Не хочу получать список процессов"?

--------------------

*щёлк*

Rennigth

Дата 14.3.2007, 15:27 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 8
Всего: 76

Ну в msdn-e написано что для

Код


  CreateToolhelp32Snapshot

Цитата

Requires Windows XP, Windows 2000 Professional, Windows Me, Windows 98, or Windows 95.

Добавлено @ 15:35

Код


  EnumProcesses

Requires Windows XP, Windows 2000 Professional, or Windows NT Workstation 4.0.

Вот для кого люди faq делают...

from vingrad faq

Код


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;

--------------------

(* Honesta mors turpi vita potior *)

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »