this slowpoke moves

Get Modules from all Process

uses tlHelp32

private
    { Private declarations }
    procedure GetModules( ProcessID: DWORD; Buf : TStrings );
    procedure GetProcesses( IncludeModules: boolean; Buf: TStrings);
    
//

procedure TForm1.GetProcesses( IncludeModules: boolean; Buf: TStrings);
const
  FmtProc = '%8.8x   %8.8x %8.8x  %3.3d    %3.3d     %3.3d  %s';
var
  hSnap     : THandle;
  ProcessEntry : TProcessEntry32; // <<==see TLHelp32.pas for details
  Proceed   : Boolean;
begin
  hSnap := CreateToolhelp32Snapshot( TH32CS_SNAPALL , 0 );
  if HSnap <> -1 then
  begin
   ProcessEntry.dwSize := SizeOf(TProcessEntry32);
   Proceed := Process32First(hSnap, ProcessEntry);
   while Proceed do
   begin
     with ProcessEntry do
     begin
      Buf.add('  ');
      Buf.Add('------------------------------------------------------');
      Buf.Add('ProcessID  ParentID ModuleID  Usage  Threads Prio Path');
      Buf.Add( Format( FmtProc, [Th32ProcessID, th32ParentProcessID,
                                         Th32ModuleID, cntUsage, cntThreads,
                                         pcPriClassBase, szEXEFile]));
      Buf.Add('------------------------------------------------------');

      if IncludeModules then
         GetModules( ProcessEntry.Th32ProcessID, Buf );
     end;
     Proceed := Process32Next( hSnap, ProcessEntry);
   end;
   CloseHandle( hSnap );
  end
  else
    ShowMessage( 'Oops...' + SysErrorMessage(GetLastError));
end;
procedure TForm1.GetModules( ProcessID: DWORD; Buf: TStrings );
const
  FmtMod = '    %8.8x  %6.1f     %4.4d %15s  %-s';
var
 hSnap : THandle;
 ModuleEntry : TModuleEntry32; // <<==see TLHelp32.pas for details
 Proceed     : Boolean;
begin
  hSnap := CreateToolhelp32Snapshot( TH32CS_SNAPMODULE , ProcessID );
  if HSnap <> -1 then
  begin

   Buf.Add(' ');
   Buf.Add('    Modules used by ProcessID ' + IntToHex(ProcessID,8));
   Buf.Add('    ModuleID   Size(kb) Usage     Module        Path');
   Buf.Add('    --------   -------- ------    ------        ----');

   ModuleEntry.dwSize := SizeOf(TModuleEntry32);
   Proceed :=  Module32First(hSnap, ModuleEntry);
   while Proceed do
   begin
     with ModuleEntry do
       Buf.add( Format( FmtMod, [Th32ModuleID, ModBaseSize/1024,
                                 GlblCntUsage,
                                 szModule,
                                 ExtractFilePath(szEXEPath)])
              );
     Proceed := Module32Next( hSnap, ModuleEntry);
   end;

   CloseHandle( hSnap );
  end
  else
    ShowMessage( 'Oops...' + SysErrorMessage(GetLastError));
end;
Module auslesen :
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.clear;
  Memo1.Lines.BeginUpdate;
  GetProcesses( CheckBox1.Checked, Memo1.Lines);
  Memo1.Lines.EndUpdate;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate