Process Viewer Component

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.

 

Share this article!

Follow us!

Find more helpful articles: