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