Mega Code Archive
Process viewer component
<![CDATA[
A Component that shows all running processes, not only on WinNT but also
on windows 98/95 !
A Component that shows all running processes, not only on WinNT but
also on windows 98/95 !
It also has a public method calld KillSelectedProcess, I guess you
can figure out what it does...
It has saved me a lot of trouble and saved me a lot of needs to
reboot my system on my windows98 machine...
well, here's the source for it :
What you will have to do is make a new unit, copy this text in it
and save the unit as ggProcessViewer.
Then you can install in into your component pallet by using the
delphi main menu, Component/Install Component...
Have a lot of fun...
unit ggProcessViewer;
interface
uses
Windows, SysUtils, Classes, Controls, Grids, ExtCtrls, messages,
tlHelp32, Dialogs;
type
//NT Functions for getting the process information :
TEnumProcesses = function(lpidProcess: LPDWORD; cb: DWORD;
var cbNeeded: DWORD): BOOL; StdCall; //external cPSAPIDLL;
TGetModuleBaseNameA = function(hProcess: THandle; hModule: HMODULE;
lpBaseName: PAnsiChar; nSize: DWORD): DWORD; StdCall; //external cPSAPIDLL;
TGetModuleFileNameExA = function(hProcess: THandle; hModule: HMODULE;
lpFilename: PAnsiChar; nSize: DWORD): DWORD; StdCall; //external cPSAPIDLL;
TEnumProcessModules = function (hProcess: THandle; lphModule: LPDWORD;
cb: DWORD; var lpcbNeeded: DWORD): BOOL; StdCall; //external cPSAPIDLL;
TPByte = ^TByte;
TByte = array[0..0] of byte;
ThackWinControl = class(TWinControl)
public
property Text;
end;
ThackGraphicControl = class(TGraphicControl)
public
property Caption;
end;
TProcessTimeType = (ptCreationTime, ptExitTime, ptKernelTime,
ptUserTime, ptCPUTime);
TAfterRefreshProcesses = procedure(Sender: TObject) of object;
TBeforeRefreshProcesses = procedure(Sender: TObject) of object;
TggProcessViewer = class(TStringGrid)
private
FProcessCount : integer;
FAutoRefresh : boolean;
FAfterRefreshProcesses : TAfterRefreshProcesses;
FBeforeRefreshProcesses : TBeforeRefreshProcesses;
RefreshTimer : TTimer;
procedure InitGridForNT;
procedure Getprocesses;
procedure GetProcessesOnNT;
function SetProcessCount: integer;
procedure GetProcessCount(const Value: integer);
procedure GetTheProcessTimes(PID: integer);
procedure SetAutoRefresh(const Value: boolean);
procedure TimerAutoRefresh(Sender: TObject);
procedure InitGridForWinXX;
procedure GetProcessesOnWinXX;
protected
//Adress holders of the procedures for NT
EnumProcesses : TEnumProcesses;
GetModuleBaseNameA : TGetModuleBaseNameA;
GetModuleFileNameExA : TGetModuleFileNameExA;
EnumProcessModules : TEnumProcessModules;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Refresh;
procedure KillSelectedProcess;
published
property DoubleBuffered;
property ProcessCount: Integer read SetProcessCount write GetProcessCount;
property AutoRefresh: Boolean read FAutoRefresh write SetAutoRefresh;
property AfterRefreshProcesses: TAfterRefreshProcesses
read FAfterRefreshProcesses write FAfterRefreshProcesses;
property BeforeRefreshProcesses: TBeforeRefreshProcesses
read FBeforeRefreshProcesses write FBeforeRefreshProcesses;
end;
procedure Register;
const
cPSAPIDLL = 'PSAPI.dll';
ProcessBasicInformation = 0;
implementation
procedure Register;
begin
RegisterComponents('GuidoG', [TggProcessViewer]);
end;
{ TggProcessViewer }
constructor TggProcessViewer.Create(AOwner: TComponent);
begin
inherited;
RefreshTimer := TTimer.Create(Self);
RefreshTimer.OnTimer := TimerAutoRefresh;
FixedCols := 0;
DefaultRowHeight := 15;
ColWidths[0] := 120;
ColWidths[1] := 60;
ColWidths[2] := 50;
ColWidths[3] := 360;
Options := Options - [goVertLine, goHorzLine] +
[goDrawFocusSelected, goThumbTracking, goColSizing, goRowSizing];
GetProcesses;
FAutoRefresh := TRUE;
end;
procedure TggProcessViewer.InitGridForNT;
begin
ColCount := 7;
RowCount := 2;
Cells[0, 0] := 'Process';
Cells[1, 0] := 'PID';
Cells[2, 0] := 'CPU time';
Cells[3, 0] := 'Kernel time';
Cells[4, 0] := 'User time';
Cells[5, 0] := 'Priority';
Cells[6, 0] := 'Location';
Cells[0, 1] := '';
Cells[1, 1] := '';
Cells[2, 1] := '';
Cells[3, 1] := '';
Cells[4, 1] := '';
Cells[5, 1] := '';
Cells[6, 1] := '';
end;
procedure TggProcessViewer.InitGridForWinXX;
begin
ColCount := 4;
RowCount := 2;
Cells[0, 0] := 'Process';
Cells[1, 0] := 'PID';
Cells[2, 0] := 'Priority';
Cells[3, 0] := 'Location';
Cells[0, 1] := '';
Cells[1, 1] := '';
Cells[2, 1] := '';
Cells[3, 1] := '';
end;
procedure TggProcessViewer.GetProcessesOnNT;
var
I : Integer;
pidNeeded : DWORD;
PIDList : array[0..1000] of Integer;
PIDName : array [0..MAX_PATH - 1] of char;
PH : THandle;
hMod : HMODULE;
dwSize2 : DWORD;
J,
ColBeforeRefresh : integer;
PIDContentsBeforeRefresh : string;
begin
ColBeforeRefresh := Col;
PIDContentsBeforeRefresh := Cells[1, Row];
Perform(WM_SETREDRAW, 0, 0);
try
InitGridForNT;
if not EnumProcesses(@PIDList, 1000, pidNeeded) then
raise Exception.Create('PSAPI.DLL not found! Are you sure you ' +
'are running windows NT/Y2K ?');
for i := 0 to (pidNeeded div SizeOf (Integer)- 1) do
begin
PH := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
FALSE, PIDList[I]);
if PH <> 0 then
begin
if GetModuleFileNameExA(PH, 0, PIDName, SizeOf(PIDName)) > 0 then
begin
if EnumProcessModules(PH, @hMod, SizeOf(hMod), dwSize2) then
begin
GetModuleFileNameExA(PH, hMod, PIDName, SizeOf(PIDName));
Cells[0, RowCount - 1] := ExtractFileName(PIDName);
Cells[1, RowCount - 1] := IntToStr(PIDList[I]);
GetTheProcessTimes(PIDList[I]);
case GetPriorityClass(PH) of
HIGH_PRIORITY_CLASS: Cells[5, RowCount - 1] := 'High';
IDLE_PRIORITY_CLASS: Cells[5, RowCount - 1] := 'Idle';
NORMAL_PRIORITY_CLASS: Cells[5, RowCount - 1] := 'Normal';
REALTIME_PRIORITY_CLASS : Cells[5, RowCount - 1] := 'RealTime';
end;
Cells[6, RowCount - 1] := ExtractFilePath(PIDName);
end;
RowCount := RowCount + 1;
CloseHandle(PH);
end;
end;
end;
if RowCount > 2 then
RowCount := RowCount - 1;
FProcessCount := RowCount - 1;
for J := 1 to RowCount - 1 do
if Cells[1, J] = PIDContentsBeforeRefresh then
begin
Col := ColBeforeRefresh;
Row := J;
Break;
end;
finally
Perform(WM_SETREDRAW, 1, 0);
Invalidate;
end;
end;
procedure TggProcessViewer.GetTheProcessTimes(PID: integer);
var
lpLocalFileTime : TFileTime;
lpSystemTime : TSystemTime;
PH : THandle;
hProcess : THandle;
lpCreationTime,
lpExitTime,
lpKernelTime,
lpUserTime : TFileTime;
KernelDay,
UserDay : integer;
KernelTime,
UserTime : TDateTime;
Result,
strHours : string;
begin
Result := 'n/a';
hProcess := PID;
PH := OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, hProcess);
if PH <> 0 then
try
GetProcessTimes(PH, lpCreationTime, lpExitTime, lpKernelTime, lpUserTime);
FileTimeToLocalFileTime(lpCreationTime, lpLocalFileTime);
//Get the kernel time and format it
FileTimeToSystemTime(lpKernelTime, lpSystemTime);
KernelDay := lpSystemTime.wDay;
KernelTime := SystemTimeToDateTime(lpSystemTime);
Result := TimeToStr(KernelTime);
strHours := Copy(Result, 1, Pos(':', Result) - 1);
Delete(Result, 1, Pos(':', Result) - 1);
Cells[3, RowCount - 1] := IntToStr(((KernelDay - 1) * 24) +
StrToInt(strHours)) + Result;
//Get the user time and format it
FileTimeToSystemTime(lpUserTime, lpSystemTime);
UserDay := lpSystemTime.wDay;
UserTime := SystemTimeToDateTime(lpSystemTime);
Result := TimeToStr(UserTime);
strHours := Copy(Result, 1, Pos(':', Result) - 1);
Delete(Result, 1, Pos(':', Result) - 1);
Cells[4, RowCount - 1] := IntToStr(((UserDay - 1) * 24) +
StrToInt(strHours)) + Result;//TimeToStr(UserTime);
//Calculate the cpu time and format it
Result := TimeToStr(UserTime + KernelTime);
strHours := Copy(Result, 1, Pos(':', Result) - 1);
Delete(Result, 1, Pos(':', Result) - 1);
Cells[2, RowCount - 1] := IntToStr(((UserDay - KernelDay) * 24) +
StrToInt(strHours)) + Result;
finally
CloseHandle(PH);
end
end;
procedure TggProcessViewer.KillSelectedProcess;
var
PH : THandle;
lpExitCode : DWord;
hProcess : Cardinal;
begin
hProcess := StrToInt64(Cells[1, Row]);
PH := OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION,
FALSE, hProcess);
if PH <> 0 then
begin
if GetExitCodeProcess(PH, lpExitCode) then
begin
if MessageBox(Handle, PChar('Do you really want me to try ' +
'to kill this process ?'), 'Please Confirm',
MB_YESNO) = mrYES then
begin
TerminateProcess(PH, lpExitCode);
MessageBox(Handle, PChar('should be dead now...'),
PChar('Check it out...'), MB_OK);
end;
end
else
MessageBox(Handle, PChar('Could not retreive the ExitCode ' +
'for this process.' + #13 + #13 +
SysErrorMessage(GetLastError)),
PChar('Something went wrong...'), MB_OK);
CloseHandle(PH);
end
else
MessageBox(Handle, PChar('Could not get access to this process.' +
#13 + #13 + SysErrorMessage(GetLastError)),
PChar('Something went wrong...'), MB_OK); Refresh;
end;
procedure TggProcessViewer.Refresh;
begin
if assigned(FBeforeRefreshProcesses) and not
(csLoading in ComponentState) then
FBeforeRefreshProcesses(Self);
GetProcesses;
if assigned(FAfterRefreshProcesses) and not
(csLoading in ComponentState) then
FAfterRefreshProcesses(Self);
end;
function TggProcessViewer.SetProcessCount: integer;
begin
Result := FProcessCount;
end;
procedure TggProcessViewer.GetProcessCount(const Value: integer);
begin
FProcessCount := RowCount - 1;
end;
procedure TggProcessViewer.SetAutoRefresh(const Value: boolean);
begin
FAutoRefresh := Value;
RefreshTimer.Enabled := FAutoRefresh;
end;
destructor TggProcessViewer.Destroy;
begin
FreeAndNil(RefreshTimer);
inherited;
end;
procedure TggProcessViewer.TimerAutoRefresh(Sender: TObject);
begin
RefreshTimer.OnTimer := NIL;
Refresh;
RefreshTimer.OnTimer := TimerAutoRefresh;
end;
procedure TggProcessViewer.GetProcessesOnWinXX;
var
aHandle : THandle;
FoundOne : bool;
ProcessEntry32 : TProcessEntry32;
ExeFile : string;
J,
ColBeforeRefresh : integer;
PIDContentsBeforeRefresh : string;
PriorityClass : DWord;
begin
ColBeforeRefresh := Col;
PIDContentsBeforeRefresh := Cells[1, Row];
Perform(WM_SETREDRAW, 0, 0);
try
InitGridForWinXX;
aHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
if aHandle <> 0 then
try
ProcessEntry32.dwSize := SizeOf(TProcessEntry32);
FoundOne := Process32First(aHandle, ProcessEntry32);
while FoundOne do
begin
ExeFile := ProcessEntry32.szExeFile;
Cells[0, RowCount - 1] := ExtractFileName(ExeFile);
Cells[1, RowCount - 1] := IntToStr(ProcessEntry32.th32ProcessID);
PriorityClass := GetPriorityClass(ProcessEntry32.th32ProcessID);
if PriorityClass <> 0 then
case PriorityClass of
HIGH_PRIORITY_CLASS: Cells[2, RowCount - 1] := 'High';
IDLE_PRIORITY_CLASS: Cells[2, RowCount - 1] := 'Idle';
NORMAL_PRIORITY_CLASS: Cells[2, RowCount - 1] := 'Normal';
REALTIME_PRIORITY_CLASS : Cells[2, RowCount - 1] := 'RealTime';
end
else
Cells[2, RowCount - 1] := IntToStr(ProcessEntry32.pcPriClassBase);
Cells[3, RowCount - 1] := ExtractFilePath(ExeFile);
RowCount := RowCount + 1;
ProcessEntry32.dwSize := SizeOf(TProcessEntry32);
FoundOne := Process32Next(aHandle, ProcessEntry32);
end;
finally
CloseHandle(ahandle);
end;
if RowCount > 2 then
RowCount := RowCount - 1;
FProcessCount := RowCount - 1;
for J := 1 to RowCount - 1 do
if Cells[1, J] = PIDContentsBeforeRefresh then
begin
Col := ColBeforeRefresh;
Row := J;
Break;
end;
finally
Perform(WM_SETREDRAW, 1, 0);
Invalidate;
end;
end;
procedure TggProcessViewer.Getprocesses;
var
HandlePSAPI_DLL : THandle;
begin
HandlePSAPI_DLL := LoadLibrary(cPSAPIDLL);
if (HandlePSAPI_DLL <> 0) then //Where on NT/2000...
begin
@EnumProcesses := GetProcAddress(HandlePSAPI_DLL, 'EnumProcesses');
@GetModuleBaseNameA := GetProcAddress(HandlePSAPI_DLL, 'GetModuleBaseNameA');
@GetModuleFileNameExA := GetProcAddress(HandlePSAPI_DLL, 'GetModuleFileNameExA');
@EnumProcessModules := GetProcAddress(HandlePSAPI_DLL, 'EnumProcessModules');
GetProcessesOnNT;
FreeLibrary(HandlePSAPI_DLL);
end
else //Where on Win95/98/ME
GetProcessesOnWinXX;
end;
end.
]]>