| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

как получить список всех запущенных приложений? [D5, Win95/98, WinME]

dolmat ©   (2003-04-18 15:11:00) 

может кто знает. подскажите. Очень нужно.
заранее благодарен.

---

Proton   (2003-04-23 19:37:00) [1]

Вообщем попытка добиться универсальности

unit ProcList;

interface

uses Windows;

type ProcessRC = record
name : string;
id : DWord;
end;
PrcList = array of ProcessRC;

Function GetProcessList9X(var List: PrcList) : DWord;
Function GetProcessListNT(var List:PrcList): DWord;
Function GetProcessList(var list:PrcList):dword;

implementation

uses TlHelp32;

function GetProcessHandle(ProcessID: DWord): THandle;
begin
Result := OpenProcess(PROCESS_ALL_ACCESS, True, ProcessID);
end;

Function GetProcessList9X(var List: PrcList) : DWord;
var
I: Integer;
hSnapshoot: integer;
pe32: TProcessEntry32;
begin
result := 0 ;
hSnapshoot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

if (hSnapshoot <> -1) then
begin
i := 0; SetLength(list,i);
pe32.dwSize := SizeOf(TProcessEntry32);
if (Process32First(hSnapshoot, pe32)) then
repeat
inc(i); SetLength(list,i);
with list[pred(i)] do
begin
name := copy(pe32.szExeFile,1,lstrlen(pe32.szExeFile));
if name = "" then name := "[<---->]";
id := pe32.th32ProcessID;
end;
until not Process32Next(hSnapshoot, pe32);

CloseHandle (hSnapshoot);
result := i;
end;
end;



/////////


type long=integer;
ThreadInfo = record
ftCreationTime : FILETIME;
dwUnknown1 : DWORD;
dwStartAddress : DWORD;
dwOwningPID : DWORD;
dwThreadID : DWORD;
dwCurrentPriority : DWORD;
dwBasePriority : DWORD;
dwContextSwitches : DWORD;
dwThreadState : DWORD;
dwUnknown2 : DWORD;
dwUnknown3 : DWORD;
dwUnknown4 : DWORD;
dwUnknown5 : DWORD;
dwUnknown6 : DWORD;
dwUnknown7 : DWORD;
end;
ProcessInfo = record
dwOffset : DWORD; // an ofset to the next Process structure
dwThreadCount : DWORD;
dwUnkown1 : array [1..6] of DWORD;
ftCreationTime : FILETIME;
dwUnkown2 : DWORD;
dwUnkown3 : DWORD;
dwUnkown4 : DWORD;
dwUnkown5 : DWORD;
dwUnkown6 : DWORD;
pszProcessName : PWCHAR;
dwBasePriority : DWORD;
dwProcessID : DWORD;
dwParentProcessID : DWORD;
dwHandleCount : DWORD;
dwUnkown7 : DWORD;
dwUnkown8 : DWORD;
dwVirtualBytesPeak : DWORD;
dwVirtualBytes : DWORD;
dwPageFaults : DWORD;
dwWorkingSetPeak : DWORD;
dwWorkingSet : DWORD;
dwUnkown9 : DWORD;
dwPagedPool : DWORD; // kbytes
dwUnkown10 : DWORD;
dwNonPagedPool : DWORD; // kbytes
dwPageFileBytesPeak : DWORD;
dwPageFileBytes : DWORD;
dwPrivateBytes : DWORD;
dwUnkown11 : DWORD;
dwUnkown12 : DWORD;
dwUnkown13 : DWORD;
dwUnkown14 : DWORD;
ati : ThreadInfo;
end;

Function GetProcessListNT(var List:PrcList): DWord;
var NtQSI: function(l1:LONG; PVOID:pointer;l2:LONG;l3:LONG):long; stdcall;
h : THANDLE ;
pinfo : ^ProcessInfo;
buf : array [1..20480] of char;
i : integer;
begin
Result := 0;
h := LoadLibrary("NTDLL.DLL");
@ntqsi := GetProcAddress(h,"NtQuerySystemInformation");
if @ntqsi <> nil then
begin
i := 0; SetLength(list,i);
FillChar(buf,sizeof(buf),#0);
ntqsi(5,@buf,sizeof(buf),0);
pinfo := @buf;
while true do
begin
inc(i); SetLength(list,i);
with list[pred(i)] do
begin
name := copy(pinfo.pszProcessName,1,lstrlenw(pinfo.pszProcessName));
if name = "" then name := "[<---->]";
id := pinfo.dwProcessID;
end;
if pinfo.dwOffset=0 then break;
pinfo := pointer(integer(@pinfo^) + integer(pinfo.dwOffset));
end;
Result := i;
end;
end;

//////////

Function GetProcessList(var list:PrcList):dword;
var vi:TOSVersionInfo;
begin
vi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(vi);
case vi.dwPlatformId of
VER_PLATFORM_WIN32s,
VER_PLATFORM_WIN32_WINDOWS : result := GetProcessList9X(list);
VER_PLATFORM_WIN32_NT : Result := GetProcessListNT(list);
else Result := GetProcessListNT(list); // default nt (win2k - nt5)
end;
end;

end.


---

XAOC   (2003-04-23 16:57:00) [2]

>dolmat
Ты уверен что у тебя не NT? :)

---

dolmat   (2003-04-22 09:45:00) [3]

>default
А где же адрес? Кньте в меня прогой.

---

Guerrilero   (2003-04-18 20:53:00) [4]

uses TLHelp32

---

DVM   (2003-04-18 17:13:00) [5]

Модуль называется не ToolHelp32!

---

default   (2003-04-18 16:54:00) [6]

пиши на мыло мне
прогу простенькую пришлю по закрытию процессов типа как в фаре

---

dolmat   (2003-04-18 16:52:00) [7]

Так и ToolHelp32 тоже ругается или я не так что-нибудь понял.

---

DVM   (2003-04-18 16:39:00) [8]

> Чего у меня не хватает?

Uses ...то что написали выше...

---

dolmat   (2003-04-18 16:25:00) [9]

Ругается TProcessEntry32 неизвестная переменная.
Чего у меня не хватает?

---

MBo   (2003-04-18 15:13:00) [10]

ToolHelp32

---

Sniffer   (2003-04-18 15:13:00) [11]

..........................
var
PE : TProcessEntry32;
Snap : THandle;
begin
Snap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
PE.dwSize := SizeOf(PE);
if Process32First(Snap, PE) then
repeat
id := PE.th32ProcessID;
...................................
until not Process32Next(Snap, PE);
.......................................

---

Наверх