Alle laufenden Prozesse auflisten & beenden eines Prozesses

[Luckie]

Mit dieser Klasse lassen sich alle laufenden Prozesse auflisten und bei Bedarf auch beenden.

Delphi-Quellcode:

(*======================================================================*
 | Project  :                                                           |
 | Unit     : ProcListCls                                               |
 |                                                                      |
 | Notes    : Class for listing and killing processes                   |
 |                                                                      |
 |                                                                      |
 | Copyright (c) 2006 Michael Puff [MPu]                                |
 | Url      : [url]http://developer.michael-puff.de[/url]                          |
 | Mail     : [email][e-mail][/email]                                     |
 |                                                                      |
 | Version  Date        By    Description                               |
 | -------  ----------  ----  ------------------------------------------|
 | 1.0      2006-03-25  MPu                                             |
 |                                                                      |
 *======================================================================*)

(*======================================================================*
 |                                                                      |
 |                        COPYRIGHT NOTICE                              |
 |                                                                      |
 | Copyright (c) 2001-2006, Michael Puff ["copyright holder(s)"]        |
 | All rights reserved.                                                 |
 |                                                                      |
 | Redistribution and use in source and binary forms, with or without   |
 | modification, are permitted provided that the following conditions   |
 | are met:                                                             |
 |                                                                      |
 | 1. Redistributions of source code must retain the above copyright    |
 |    notice, this list of conditions and the following disclaimer.     |
 | 2. Redistributions in binary form must reproduce the above copyright |
 |    notice, this list of conditions and the following disclaimer in   |
 |    the documentation and/or other materials provided with the        |
 |    distribution.                                                     |
 | 3. The name(s) of the copyright holder(s) may not be used to endorse |
 |    or promote products derived from this software without specific   |
 |    prior written permission.                                         |
 |                                                                      |
 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS  |
 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT    |
 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS    |
 | FORA PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE        |
 | REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,          |
 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, |
 | BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;     |
 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER     |
 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT   |
 | LIABILITY, OR TORT INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY |
 | WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE          |
 | POSSIBILITY OF SUCH DAMAGE.                                          |
 |                                                                      |
 *======================================================================*)

unit ProcListCls;

interface

uses
  Windows,
  SysUtils,
  Dialogs,
  TlHelp32;

type
  TProcess = packed record
    Filename: string;
    ProcID: DWORD;
    ParentID: DWORD;
    Priority: DWORD;
    Threads: DWORD;
  end;

  TOnProcListStart = procedure(Sender: TObject) of object;
  TOnProcListFinished = procedure(Sender: TObject; CountProcs: Integer) of object;
  TOnProcRetrieve = procedure(Sender: TObject; Process: TProcess) of object;
  TOnListFailure = procedure(Sender: TObject; ErrorCode: Integer; const ErrorString: string) of object;
  TOnKillFailure = procedure(Sender: TObject; ErrorCode: Integer; const ErrorString: string) of object;

  TProcList = class(TObject)
  private
    FProcess: TProcess;
    FCountProcs: Integer;
    FOnProcListStart: TOnProcListStart;
    FOnProcListFinished: TOnProcListFinished;
    FOnProcRetrieve: TOnProcRetrieve;
    FOnListFailure: TOnListFailure;
    FOnKillFailure: TOnKillFailure;
  protected
    function GetProcPath(ProcID: DWORD): string;
    function GetProcID(const Filename: String): DWORD;
  public
    constructor Create;
    procedure Execute;
    procedure KillProc(const Filename: string; TimeOut: DWORD); overload;
    procedure KillProc(ID: Integer; TimeOut: DWORD); overload;
    property OnProcListStart: TOnProcListStart read FOnProcListStart write FOnProcListStart;
    property OnProcListFinished: TOnProcListFinished read FOnProcListFinished write FOnProcListFinished;
    property OnProcRetrieve: TOnProcRetrieve read FOnProcRetrieve write FOnProcRetrieve;
    property OnListFailure: TOnListFailure read FOnListFailure write FOnListFailure;
    property OnKillFailure: TOnKillFailure read FOnKillFailure write FOnKillFailure;
  end;

implementation

{ TProcList }

constructor TProcList.Create;
begin
  inherited;
  FCountProcs := 0;
end;

procedure TProcList.Execute;
var
  hProcSnapShot     : THandle;
  pe32              : TProcessEntry32;
  ModuleEntry       : TModuleEntry32;
  FileName          : string;
begin
  // make the snapshot
  if Assigned(OnProcListStart) then
    FOnProcListStart(self);
  hProcSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS or TH32CS_SNAPMODULE, 0);
  if hProcSnapShot <> INVALID_HANDLE_VALUE then
  begin
    pe32.dwSize := sizeof(TProcessEntry32);
    ModuleEntry.dwSize := SizeOf(TModuleEntry32);
    if Process32First(hProcSnapShot, pe32) then
    begin
      // first process (System Process)
      Inc(FCountProcs);
      FProcess.ProcID := pe32.th32ProcessID;
      FProcess.Filename := pe32.szExeFile;
      FProcess.Priority := pe32.pcPriClassBase;
      FProcess.Threads := pe32.cntThreads;
      if Assigned(OnProcRetrieve) then
        FOnProcRetrieve(self, FProcess);
      // walk the processes
      while Process32Next(hProcSnapShot, pe32) do
      begin
        FProcess.ProcID := pe32.th32ProcessID;
        FileName := GetProcPath(pe32.th32ProcessID);
        if FileName <> '' then
          FProcess.Filename := FileName
        else
          FProcess.Filename := pe32.szExeFile;
        FProcess.Priority := pe32.pcPriClassBase;
        FProcess.Threads := pe32.cntThreads;
        Inc(FCountProcs);
        if Assigned(OnProcRetrieve) then
          FOnProcRetrieve(self, FProcess);
      end;
    end
    else // Process32First = False
    begin
      if Assigned(OnListFailure) then
        FOnListFailure(self, GetLastError, SysErrorMessage(GetLastError));
      CloseHandle(hProcSnapShot);
    end;
  end
  else // hSnapShot = INVALID_HANDLE_VALUE
  begin
    if Assigned(OnListFailure) then
      FOnListFailure(self, GetLastError, SysErrorMessage(GetLastError));
  end;

  if Assigned(OnProcListFinished) then
    FOnProcListFinished(self, FCountProcs);
end;

function TProcList.GetProcPath(ProcID: DWORD): string;
var
  me32              : TModuleEntry32;
  h                 : THandle;
  s                 : string;
begin
  s := '';
  h := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcID);
  if h <> INVALID_HANDLE_VALUE then
  begin
    me32.dwSize := sizeof(TModuleEntry32);
    Module32First(h, me32);
    s := me32.szExePath;
    CloseHandle(h);
  end;
  result := s;
end;

function TProcList.GetProcID(const Filename: String): DWORD;
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
begin
  result := 0;
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap <> INVALID_HANDLE_VALUE then
  begin
    pe32.dwSize := SizeOf(ProcessEntry32);
    if Process32First(hProcSnap, pe32) then
    begin
      while Process32Next(hProcSnap, pe32) do
      begin
        if pos(AnsiLowerCase(pe32.szExeFile), AnsiLowerCase(ExtractFilename(Filename))) > 0 then
        begin
          result := pe32.th32ProcessID;
          break;
        end;
      end;
    end;
    CloseHandle(hProcSnap);
  end;
end;

procedure TProcList.KillProc(ID: Integer; TimeOut: DWORD);
var
  hProcess          : Cardinal;
  err               : DWORD;
begin
  // open the process and store the process-handle
  hProcess := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, ID);
  // kill it
  if hProcess <> 0 then
  begin
    err := Integer(TerminateProcess(hProcess, 1));
    if err <> 0 then
    begin
      // TerminateProcess returns immediately, so wie have to verify the result via
      // WaitForSingleObject
      err := WaitForSingleObject(hProcess, TimeOut);
      if err = WAIT_FAILED then
      begin
        if Assigned(OnKillFailure) then
          FOnKillFailure(self, GetLastError, SysErrorMessage(GetLastError));
      end;
    end
    else
    begin
      if Assigned(OnKillFailure) then
        FOnKillFailure(self, GetLastError, SysErrorMessage(GetLastError));
    end;
    CloseHandle(hProcess);
  end
  else // hProcess = INVALID_HANDLE_VALUE
  begin
    if Assigned(OnKillFailure) then
      FOnKillFailure(self, GetLastError, SysErrorMessage(GetLastError));
  end;
end;

procedure TProcList.KillProc(const Filename: string; TimeOut: DWORD);
begin
  KillProc(GetProcID(Filename), TimeOut);
end;

[edit=Matze]Hinweis hinzugefügt. Mfg, Matze[/edit]
[edit=Matze]"Jugendsünde" entfernt und sauberen Code von Luckie eingefügt. Mfg, Matze[/edit]
[edit=Matze] Mfg, Matze[/edit]