// Klasse zum Benden eines Processes mittels TerminateProcess
// Class for terminating a process via TerminateProcess
// Michael Puff [http://www.michael-puff.de]
// 2010-11-22
unit MpuKillProcessCls;
interface
uses
Windows,
Messages,
SysUtils,
TlHelp32;
type
TOnTerminated =
procedure(HasTerminated: Boolean; ProcessExefile:
string)
of object;
TOnProcessNotFound =
procedure(ProcessExefile:
string)
of object;
TKillProcess =
class(TObject)
private
FProcessExefile:
string;
FProcessID: Cardinal;
FTimeOut: Cardinal;
FOnTerminated: TOnTerminated;
FOnProcessNotFound: TOnProcessNotFound;
function GetProcessID: Cardinal;
procedure SetProcessExefile(
const Value:
string);
procedure SetPID(Value: Cardinal);
function EnablePrivilege(
const Privilege:
string; fEnable: Boolean;
out
PreviousState: Boolean): DWORD;
public
property ProcessExefile:
string read FProcessExefile
write SetProcessExefile;
property PID: Cardinal
read FProcessID
write SetPID;
property TimeOutMSecs: Cardinal
read FTimeOut
write FTimeOut;
property OnTerminated: TOnTerminated
read FOnTerminated
write FOnTerminated;
property OnProcessNotFound: TOnProcessNotFound
read FOnProcessNotFound
write FOnProcessNotFound;
constructor Create;
procedure Kill;
end;
implementation
constructor TKillProcess.Create;
begin
FTimeOut := 0;
end;
function TKillProcess.EnablePrivilege(
const Privilege:
string;
fEnable: Boolean;
out PreviousState: Boolean): DWORD;
var
Token: THandle;
NewState: TTokenPrivileges;
Luid: TLargeInteger;
PrevState: TTokenPrivileges;
Return: DWORD;
begin
PreviousState := True;
if (GetVersion() > $80000000)
then
// Win9x
Result := ERROR_SUCCESS
else
begin
// WinNT
if not OpenProcessToken(GetCurrentProcess(), MAXIMUM_ALLOWED, Token)
then
Result := GetLastError()
else
try
if not LookupPrivilegeValue(
nil, PChar(Privilege), Luid)
then
Result := GetLastError()
else
begin
NewState.PrivilegeCount := 1;
NewState.Privileges[0].Luid := Luid;
if fEnable
then
NewState.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else
NewState.Privileges[0].Attributes := 0;
if not AdjustTokenPrivileges(Token, False, NewState,
SizeOf(TTokenPrivileges), PrevState, Return)
then
Result := GetLastError()
else
begin
Result := ERROR_SUCCESS;
PreviousState :=
(PrevState.Privileges[0].Attributes
and SE_PRIVILEGE_ENABLED <> 0);
end;
end;
finally
CloseHandle(Token);
end;
end;
end;
function TKillProcess.GetProcessID: Cardinal;
var
ProcessSnapShot: THandle;
pe32: TProcessEntry32;
ProcessID: Cardinal;
begin
ProcessID := 0;
ProcessSnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
if ProcessSnapShot <> INVALID_HANDLE_VALUE
then
begin
pe32.dwSize := SizeOf(ProcessEntry32);
if Process32First(ProcessSnapShot, pe32)
then
begin
while Process32Next(ProcessSnapShot, pe32)
do
begin
if AnsiSameText(FProcessExefile, pe32.szExeFile)
then
begin
ProcessID := pe32.th32ProcessID;
Break;
end;
end;
end
else
begin
RaiseLastOSError;
end;
end
else
begin
RaiseLastOSError;
end;
CloseHandle(ProcessSnapShot);
if ProcessID = 0
then
begin
if Assigned(OnProcessNotFound)
then
OnProcessNotFound(FProcessExefile);
end;
Result := ProcessID;
end;
procedure TKillProcess.Kill;
var
EnablePrivelege: DWORD;
PreviousPriviliegeState: Boolean;
ProcessHandle: Cardinal;
WFSOReturnCode: DWORD;
begin
FProcessID := GetProcessID;
if FProcessID <> 0
then
begin
repeat
EnablePrivelege := EnablePrivilege('
SE_DEBUG_NAME', true, PreviousPriviliegeState);
if EnablePrivelege <> 0
then
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 GetProcessID = 0
then
begin
if Assigned(OnTerminated)
then
OnTerminated(True, FProcessExefile);
end
else
begin
if Assigned(OnTerminated)
then
OnTerminated(False, FProcessExefile);
Exit;
end;
if FTimeOut > 0
then
begin
raise Exception.Create('
Timeout');
end;
end;
WAIT_FAILED:
begin
RaiseLastOSError;
end;
WAIT_OBJECT_0:
begin
if Assigned(OnTerminated)
then
OnTerminated(True, FProcessExefile);
end;
end;
end
else
begin
RaiseLastOSError;
end;
CloseHandle(ProcessHandle);
end
else
begin
RaiseLastOSError;
end;
end
else
begin
raise Exception.Create(SysErrorMessage(GetLastError));
end;
FProcessID := GetProcessID;
until FProcessID = 0;
end;
end;
procedure TKillProcess.SetProcessExefile(
const Value:
string);
begin
FProcessExefile := Value;
end;
procedure TKillProcess.SetPID(Value: Cardinal);
begin
FProcessID := Value;
end;
end.