uses TlHelp32, PsAPI;
{*
* Procedure : KillProcess
* Author : Michael Puff
* Date : 2006-09-15
* Terminates a process identified by its PID
*}
function KillProcess(dwProcID, Wait: DWORD): Integer;
var
hProcess : Cardinal;
dw : DWORD;
begin
// open the process and store the process-handle
hProcess := OpenProcess(SYNCHRONIZE
or PROCESS_TERMINATE, False, dwProcID);
// kill it
if hProcess <> 0
then
begin
dw := Integer(TerminateProcess(hProcess, 1));
if dw <> 0
then
begin
// TerminateProcess returns immediately, so we have to verify the result via
// WaitForSingleObject
dw := WaitForSingleObject(hProcess, Wait);
if dw = WAIT_FAILED
then
dw := GetLastError;
end
else // TerminateProcess = 0
dw := GetLastError;
CloseHandle(hProcess);
end
else // hProcess = INVALID_HANDLE_VALUE
dw := GetLastError;
result := dw;
end;
function ProcessExists(
const AFileName:
string;
var FoundFiles: TStringList;
const IncludeHost: Boolean = False;
const Kill: Boolean = False): Boolean;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
fullPath:
string;
myHandle: THandle;
myPID: DWORD;
OwnPID: Cardinal;
begin
FoundFiles := TStringList.Create;
OwnPID := GetCurrentProcessId;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
Result := False;
while Integer(ContinueLoop) <> 0
do
begin
if UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExtractFileName(AFileName))
then
begin
myPID := FProcessEntry32.th32ProcessID;
if (Kill = True)
then
if (OwnPID <> myPID)
then
KillProcess(myPID, 500);
// Wenn Du hier noch eine Null ranhängst, gibst Du der Kill Funktion 5 Sekunden Zeit zum Abschluss zu kommen
myHandle := OpenProcess(PROCESS_QUERY_INFORMATION
or PROCESS_VM_READ, False, myPID);
if myHandle <> 0
then
try
SetLength(fullPath, MAX_PATH);
if GetModuleFileNameEx(myHandle, 0, PChar(fullPath), MAX_PATH) > 0
then
begin
SetLength(fullPath, StrLen(PChar(fullPath)));
if UpperCase(ExtractFilename(fullPath)) = UpperCase(ExtractFilename(AFileName))
then
if (IncludeHost=False)
then
begin
if (OwnPID <> myPID)
then
FoundFiles.Add(fullPath);
end
else
FoundFiles.Add(fullPath);
if UpperCase(fullPath) = UpperCase(AFileName)
then
Result := True;
end else
fullPath := '
';
finally
CloseHandle(myHandle);
end;
{if Result then
Break;}
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
s: TStringList;
i: Integer;
begin
Memo1.Clear;
processExists(Application.ExeName,S, Checkbox1.Checked, Checkbox2.Checked);
for i := 0
to S.Count -1
do
Memo1.Lines.Add(S.Strings[i]);
end;