Как получить список процессов в WinNT 2000?

← →
MPS © (2004-01-16 16:59) [0]

Как получить список процессов в WinNT\2000?

← →
Digitman © (2004-01-16 17:45) [1]

unit NfoMain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, psapi, ComCtrls, ExtCtrls;

const
WM_REFRESH = WM_USER + 30561;

type
TfrmNfoMain = class(TForm)
lvPList: TListView;
Panel1: TPanel;
Button1: TButton;
Timer: TTimer;
TrackBar1: TTrackBar;
Label1: TLabel;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
private
FFullFilePath: String;
FFilePath: String;
FFullFileName: String;
FFileExt: String;
procedure MsgRefresh(var Message: TMessage); message WM_REFRESH;
procedure DoParseFilePath;
function CheckCmdLine: Boolean;
function GetActivePIDs: TList;
function GetModules(hProcess: THandle): TList;
function GetModuleFileName(hProcess, hModule: THandle): String;
function GetModuleFileNames(hProcess: THandle; Modules: TList): TStrings;
procedure Refresh;
public
procedure ViewModuleUsage(const ModuleFile: String);
end;

var
frmNfoMain: TfrmNfoMain;

implementation

{$R *.DFM}

{ TfrmNfoMain }

const
MAXPIDS = 4096;
MAXMODULES = 1024;

function TfrmNfoMain.CheckCmdLine: Boolean;
begin
if ParamCount > 0 then
FFullFilePath := ParamStr(1)
else
FFullFilePath := "";
Result := FFullFilePath <> "";
end;

function TfrmNfoMain.GetActivePIDs: TList;
var
BytesReturned: DWord;
begin
Result := TList.Create;
with Result do
try
Count := MAXPIDS;
if EnumProcesses(Pointer(List), Count * SizeOf(DWord), BytesReturned) then
Count := BytesReturned div SizeOf(DWord)
else
Clear;
except
Free;
raise;
end;
end;

function TfrmNfoMain.GetModules(hProcess: THandle): TList;
var
BytesReturned: DWord;
begin
Result := TList.Create;
with Result do
try
Count := MAXMODULES;
if EnumProcessmodules(hProcess, Pointer(List), Count * SizeOf(THandle), BytesReturned) then
Count := BytesReturned div SizeOf(THandle)
else
Clear;
except
Free;
raise;
end;
end;

function TfrmNfoMain.GetModuleFileName(hProcess, hModule: THandle): String;
var
nSize: Integer;
begin
SetLength(Result, MAX_PATH);
nSize := GetModuleFileNameEx(hProcess, hModule, PChar(Result), MAX_PATH);
Win32Check(nSize > 0);
SetLength(Result, nSize);
end;

function TfrmNfoMain.GetModuleFileNames(hProcess: THandle; Modules: TList): TStrings;
var
i: Integer;
hModule: THandle;
begin
Result := TStringList.Create;
with Result do
try
i := 0;
while i < Modules.Count do
begin
hModule := THandle(Modules[i]);
try
AddObject(GetModuleFileName(hProcess, hModule), Pointer(hModule));
except
end;
Inc(i);
end;
except
Free;
raise;
end;
end;

← →
Digitman © (2004-01-16 17:45) [2]

function SetDebugPriv: Boolean;
var
hToken: THandle;
tkp: TTokenPrivileges;
begin
Result := false;
if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
try
if LookupPrivilegeValue(nil, PChar("SeDebugPrivilege"), tkp.Privileges[0].Luid) then
begin
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
Result := AdjustTokenPrivileges(hToken, false, tkp, 0, PTokenPrivileges(nil)^, PDWord(nil)^);
end;
finally
Closehandle(hToken);
end;
end;

procedure TfrmNfoMain.FormCreate(Sender: TObject);
begin
Label2.Caption := IntToStr(Trackbar1.Position) + " sec";
Timer.Interval := Trackbar1.Position * 1000;
if CheckCmdLine then
PostMessage(Handle, WM_REFRESH, 0, 0);
end;

procedure TfrmNfoMain.Refresh;
var
hProcess: THandle;
li: TListItem;
PIDs, Modules: TList;
ModNames: TStrings;
PrFilePath, PrBaseName, ModBaseName, ModFilePath: String;
i, k: Integer;
modinfo: TModuleInfo;
begin
if FFullFilePath <> "" then
Caption := "Usage of module : " + FFullFilePath
else
Caption := "Usage of module : (not specified)";
with lvPList.Items do
begin
BeginUpdate;
try
Clear;
if (FFullFilePath = "") or not FileExists(FFullFilePath) then
Exit;
PIDs := GetActivePIDs;
try
i:= 0;
while i < PIDs.Count do
begin
hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, Cardinal(PIDs[i]));
if hProcess <> 0 then
try
Modules := GetModules(hProcess);
try
ModNames := GetModuleFileNames(hProcess, Modules);
try
k := 0;
while k < ModNames.Count do
begin
ModBaseName := ExtractFileName(ModNames[k]);
ModFilePath := ExtractFilePath(ModNames[k]);
if k = 0 then
begin
PrBaseName := ModBaseName;
PrFilePath := ModFilePath;
end;
if (CompareText(ModBaseName, FFullFileName) = 0)
and (CompareText(ModFilePath, FFilePath) = 0) then
begin
li := Add;
li.Caption := PrBaseName;
li.Data := PIDs[i];
with li.SubItems do
begin
AddObject(IntToStr(Cardinal(PIDs[i])), nil);
AddObject(PrFilePath, nil);
AddObject(IntToHex(Cardinal(ModNames.Objects[k]), 8), ModNames.Objects[k]);
end;
Break;
end;
Inc(k);
end;
finally
ModNames.Free;
end;
finally
Modules.Free;
end;
finally
Closehandle(hProcess);
end;
Inc(i);
end;
finally
PIDs.Free;
end;
finally
EndUpdate;
end;
end;
end;

procedure TfrmNfoMain.Button1Click(Sender: TObject);
begin
if Timer.Enabled then
begin
Timer.Enabled := False;
Button1.Caption := "Enable AutoRefresh";
end
else
begin
PostMessage(Handle, WM_REFRESH, 0, 0);
Timer.Enabled := True;
Button1.Caption := "Disable AutoRefresh";
end;
end;

procedure TfrmNfoMain.DoParseFilePath;
begin
FFilePath := ExtractFilePath(FFullFilePath);
FFullFileName := ExtractFileName(FFullFilePath);
FFileExt := ExtractFileExt(FFullFileName);
end;

procedure TfrmNfoMain.MsgRefresh(var Message: TMessage);
begin
DoParseFilePath;
Refresh;
end;

procedure TfrmNfoMain.ViewModuleUsage(const ModuleFile: String);
begin
FFullFilePath := Trim(ModuleFile);
PostMessage(Handle, WM_REFRESH, 0, 0);
end;

procedure TfrmNfoMain.TimerTimer(Sender: TObject);
begin
if FFullFilePath = "" then
Timer.Enabled := False
else
PostMessage(Handle, WM_REFRESH, 0, 0);
end;

procedure TfrmNfoMain.TrackBar1Change(Sender: TObject);
begin
Label2.Caption := IntToStr(Trackbar1.Position) + " sec";
Timer.Interval := Trackbar1.Position * 1000;
end;

initialization
SetDebugPriv;

end.

← →
MPS © (2004-01-17 05:23) [3]

Digitman © (16.01.04 17:45) [1]

Приогромно благодарен!

← →
-=наблюдатель=- © (2004-01-17 16:27) [4]

Ну нифига себе!! А ведь человек просто хотел узнать как получить список процессов!! Вот это я понимаю полный и исчерпывющий ответ

← →
Songoku © (2004-01-17 17:51) [5]

2 -=наблюдатель=-:
Ты что с дерева упал???? Какой это ответ???
Это просто исходник! Тут даже описания нету!

← →
DVM © (2004-01-17 18:45) [6]

Ответ не полный, т.к. в разных системах NT/2000/98 получение инфы о процессах производится по-разному (psapi или toolhelp32)
Подробно данная вещь описывается в книге:
Стив Тейксер и Ксавье Пачек
"Delphi 5 Руководство разработчика" в двух томах.

Если только NT/2000, то кроме PSAPI, можно еще полудокументированной функцией ZwQuerySystemInformation(),
через счетчики производительности (из реестра), и с использованием WMI.
В 2000 и выше также доступна ToolHelp32.

Как получить список процессов в WinNT 2000? Найти похожие ветки