Форум: "Система";
Текущий архив: 2004.03.28;
Скачать: [xml.tar.bz2];

Вниз

!!!!!!!!!!!!!!!!!!<NtQuerySystemInformation>!!!!!!!!!!!!!!!   Найти похожие ветки 

← →
Davey   (2003-12-30 13:16) [0]

Уважаемые программисты, у меня следующая проблема: вывожу список процессов под ХР, все процессы показывает кроме моего (программа, которая собственно и показывает все запущенные процессы). Подскажите что не так. Исходник прилогаю ниже.

Unit ProcessList;
Interface
Uses Windows, Classes;

Procedure GetProcessList(Const List: TStrings);

Implementation
Uses SysUtils;
Type
 TThreadInfo = Record
   ftCreationTime: TFileTime;
   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;
 TProcessInfo = Record
   dwOffset: DWORD;
   dwThreadCount: DWORD;
   dwUnkown1: Array[0..5] Of DWORD;
   ftCreationTime: TFileTime;
   dwUnkown2: DWORD;
   dwUnkown3: DWORD;
   dwUnkown4: DWORD;
   dwUnkown5: DWORD;
   dwUnkown6: DWORD;
   pszProcessName: pwideChar;
   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;
   dwUnkown10: DWORD;
   dwNonPagedPool: DWORD;
   dwPageFileBytesPeak: DWORD;
   dwPageFileBytes: DWORD;
   dwPrivateBytes: DWORD;
   dwUnkown11: DWORD;
   dwUnkown12: DWORD;
   dwUnkown13: DWORD;
   dwUnkown14: DWORD;
   ati: Array[0..0] Of TThreadInfo;
 End;
Type
 PProcessInfo = ^TProcessInfo;
 PThreadInfo = ^TThreadInfo;
Type
 tFuncNtQsI = Function(a: Longint; Buffer: Pointer; SizeBuffer: Longint; Tmp:
   Longint): Longint; stdcall;

Procedure GetProcessList;
Var
 pInfo: PProcessInfo;
 buf: Array[0..20479] Of Char;
 h: THandle;
 ff: tFuncNtQsI;
 ss: pchar;
 i, k: Integer;
Begin
 If Win32Platform = VER_PLATFORM_WIN32_NT Then
 Begin
   List.Clear;
   h := LoadLibrary("NTDLL.DLL");
   If h > 0 Then
   Begin
     @ff := GetProcAddress(h, "NtQuerySystemInformation");
     If @ff <> Nil Then
     Begin
       ff(5, @buf, 20480, 0);
       pInfo := @buf;
       Repeat
         Try
           If pInfo^.pszProcessName <> Nil Then
             List.Add(WideCharToString(pInfo^.pszProcessName));
           pInfo := Ptr(Integer(pInfo) + pInfo^.dwOffset);
         Except
           break;
         End;
       Until pInfo^.dwOffset = 0;
     End;
     FreeLibrary(h);
   End;
 End;
End;

End.

---

← →
Woodpecker ©   (2003-12-30 15:35) [1]

OFF: чем больше восклицательных знаков, тем меньше внимания.

---

← →
Digitman ©   (2003-12-30 15:42) [2]


library PEHelper;

uses
 ComServ,
 PEModNfo in "PEModNfo.pas",
 NfoMain in "NfoMain.pas" {frmNfoMain};

exports
 DllGetClassObject,
 DllCanUnloadNow,
 DllRegisterServer,
 DllUnregisterServer;

{$R *.RES}

begin
end.

////////////////

unit PEModNfo;

interface

uses
 Windows, ActiveX, ComObj, ShlObj;

type
 TTPEModNfo = class(TComObject, IShellExtInit, IContextMenu)
 private
   FFileName: String;
   FViewMenuItem: UINT;
   function IShellExtInit.Initialize = InitShellExtension;
 protected
   { IShellExtInit }
   function InitShellExtension(pidFolder: PItemIdList; lpdobj: IDataObject; hKeyProgId: HKEY): HResult; stdcall;
   { IContextMenu }
   function QueryContextMenu(Menu: HMENU; IndexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
   function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: PChar; cchMax: UINT): HResult; stdcall;
   function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
 end;

 TTPEModNfoFactory = class(TComObjectFactory)
 private
 public
   procedure UpdateRegistry(Register: Boolean); override;
 end;
const
 Class_TPEModNfo: TGUID = "{D4A3B54C-0C94-4F81-9D33-65AD728855C1}";

implementation

uses ComServ, ShellAPI, SysUtils, NfoMain;

{ TTPEModNfo }

function TTPEModNfo.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: PChar; cchMax: UINT): HResult;
begin
 Result := S_OK;
 if (idCmd = FViewMenuItem) and ((uType and GCS_HELPTEXT) <> 0) then
   StrLCopy(pszName, "View usage of module", cchMax)
 else
   Result := E_INVALIDARG;
end;

function TTPEModNfo.InitShellExtension(pidFolder: PItemIdList; lpdobj: IDataObject; hKeyProgId: HKEY): HResult;
var
 Format: TFormatEtc;
 Medium: TStgMedium;
begin
 Result := E_FAIL;
 if lpdobj = nil then Exit;
 with Format do begin
   cfformat := CF_HDROP;
   ptd := nil;
   dwAspect := DVASPECT_CONTENT;
   lindex := 1;
   tymed := TYMED_HGLOBAL;
 end;
 Result := lpdobj.GetData(Format, Medium);
 if Failed(Result) then
   Exit;
 try
   if DragQueryFile(Medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
     begin
       Setlength(FFileName, MAX_PATH);
       SetLength(FFileName, DragQueryFile(Medium.hGlobal, 0, PChar(FFileName), MAX_PATH));
       Result := NOERROR;
     end;
 finally
   ReleaseStgMedium(Medium);
 end;
end;

function TTPEModNfo.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
 MI: Integer;
 frmNfoMain: TfrmNfoMain;
begin
 Result := S_OK;
 MI := Integer(lpici.lpverb);
 if HiWord(MI) <> 0 then
   Result := E_FAIL
 else if LoWord(MI) <> FViewMenuItem then
   Result := E_INVALIDARG;
 frmNfoMain := TfrmNfoMain.Create(nil);
 try
   frmNfoMain.ViewModuleUsage(FFileName);
   frmNfoMain.ShowModal;
 finally
   frmNfoMain.Free;
 end;

end;

function TTPEModNfo.QueryContextMenu(Menu: HMENU; IndexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
var
 MenuText: String;
begin
 Result := NOERROR;
 MenuText := "View module usage";
 FViewMenuItem := IndexMenu;
 if (uFlags and $000F) = CMF_NORMAL then
   begin
     InsertMenu(Menu, FViewMenuItem, MF_STRING or MF_BYPOSITION, idCmdFirst, PChar(MenuText));
     Result := 1;
   end
 else if (uFlags and CMF_EXPLORE) <> 0 then
   begin
     InsertMenu(Menu, FViewMenuItem, MF_STRING or MF_BYPOSITION, idCmdFirst, PChar(MenuText));
     Result := 1;
   end
 else if (uFlags and CMF_VERBSONLY) <> 0 then
   begin
     InsertMenu(Menu, FViewMenuItem, MF_STRING or MF_BYPOSITION, idCmdFirst, PChar(MenuText));
     Result := 1;
   end;
end;

{ TTPEModNfoFactory }

procedure TTPEModNfoFactory.UpdateRegistry(Register: Boolean);
var
 keystr, valstr: String;
begin
 inherited UpdateRegistry(Register);
 keystr := "\ShellEx\ContextMenuHandlers\View usage";
 if Register then
   begin
     valstr := GUIDToString(ClassId);
     CreateRegKey("dllfile" + keystr , "", valstr);
     CreateRegKey("exefile" + keystr, "", valstr);
     CreateRegKey("bplfile" + keystr , "", valstr);
   end
 else
   begin
     DeleteRegKey("dllfile" + keystr);
     DeleteRegKey("exefile" + keystr);
     DeleteRegKey("bplfile" + keystr);
   end;
end;

initialization
 TTPEModNfoFactory.Create(ComServer, TTPEModNfo, Class_TPEModNfo,
   "TPEModNfo", "PE-module usage info", ciMultiInstance, tmApartment);

end.


---

← →
Digitman ©   (2003-12-30 15:49) [3]

(c) Эрик Хармон

---

← →
Digitman ©   (2003-12-30 17:12) [4]

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;

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;

---

← →
Digitman ©   (2003-12-30 17:14) [5]

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.

(c) без оного.
просто как иллюстрация алгоритма перечисления процессов на НТ-платформах

---

Страницы: 1 вся ветка

Форум: "Система";
Текущий архив: 2004.03.28;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.51 MB
Время: 0.033 c