// Klasse zum Benden eines Processes mittels TerminateProcess
// Class for terminating a process via TerminateProcess
// Michael Puff [http://www.michael-puff.de]
unit MpuKillProcessCls;
interface
uses
Windows, SysUtils, TlHelp32;
type
TKillProcess =
class(TObject)
private
FProcessFile:
string;
FProcessID: Integer;
FTimeOut: Cardinal;
procedure GetProcessID;
public
property ProcessFile:
string read FProcessFile
write FProcessFile;
property TimeOutMSecs: Cardinal
read FTimeOut
write FTimeOut;
constructor Create(ProcessFile:
string);
procedure Kill;
end;
implementation
constructor TKillProcess.Create(ProcessFile:
string);
begin
FProcessFile := ProcessFile;
FTimeOut := 0;
GetProcessID;
end;
procedure TKillProcess.GetProcessID;
var
ProcessSnapShot: THandle;
pe32: TProcessEntry32;
begin
ProcessSnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
if ProcessSnapShot <> INVALID_HANDLE_VALUE
then
begin
pe32.dwSize := SizeOf(ProcessEntry32);
if Process32First(ProcessSnapShot, pe32) = true
then
begin
while Process32Next(ProcessSnapShot, pe32) = true
do
begin
if pos(LowerCase(FProcessFile), LowerCase(pe32.szExeFile)) <> 0
then
FProcessID := pe32.th32ProcessID;
end;
end
else
begin
RaiseLastOSError;
end;
end
else
begin
RaiseLastOSError;
end;
CloseHandle(ProcessSnapShot);
if FProcessID = 0
then
raise Exception.Create('
Process not found');
end;
procedure TKillProcess.Kill;
var
ProcessHandle: Cardinal;
WFSOReturnCode: DWORD;
begin
ProcessHandle := OpenProcess(SYNCHRONIZE
or PROCESS_TERMINATE, False, FProcessID);
if ProcessHandle <> 0
then
begin
if TerminateProcess(ProcessHandle, 0)
then
begin
WFSOReturnCode := WaitForSingleObject(ProcessHandle, FTimeOut);
case WFSOReturnCode
of
WAIT_TIMEOUT:
begin
if FTimeOut > 0
then
raise Exception.Create('
Timeout');
end;
WAIT_FAILED:
begin
RaiseLastOSError;
end;
end;
end
else
begin
RaiseLastOSError;
end;
end
else
begin
RaiseLastOSError;
end;
end;
end.