AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Windows API / MS.NET Framework API Delphi Alle laufenden Prozesse auflisten & beenden eines Prozesses

Alle laufenden Prozesse auflisten & beenden eines Prozesses

Ein Thema von Luckie · begonnen am 5. Jan 2003
Antwort Antwort
Benutzerbild von Luckie
Luckie
(Moderator)

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#1

Alle laufenden Prozesse auflisten & beenden eines Prozes

  Alt 5. Jan 2003, 04:35
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]mpuff@michael-puff.de[/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]
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 13:45 Uhr.
Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf