Если вы счастливы написать свою собственную DLL, вы можете использовать API справки инструмента для TlHelp32.pas, чтобы определить, какие приложения работают, а затем получить дескриптор окна для них с помощью EnumWindows, а затем отправить WM_CLOSE дескриптору окна.,
Это немного мучительно, но это должно сработать: у меня есть несколько классов-утилит, которые я разработал с другом некоторое время назад.Не могу вспомнить, основали ли мы его на чужом коде.
TWindows.ProcessISRunning и TWindows.StopProcess могут помочь.
interface
uses
Classes,
Windows,
SysUtils,
Contnrs,
Messages;
type
TProcess = class(TObject)
public
ID: Cardinal;
Name: string;
end;
TWindow = class(TObject)
private
FProcessID: Cardinal;
FProcessName: string;
FHandle: THandle;
FProcessHandle : THandle;
function GetProcessHandle: THandle;
function GetProcessID: Cardinal;
function GetProcessName: string;
public
property Handle : THandle read FHandle;
property ProcessName : string read GetProcessName;
property ProcessID : Cardinal read GetProcessID;
property ProcessHandle : THandle read GetProcessHandle;
end;
TWindowList = class(TObjectList)
private
function GetWindow(AIndex: Integer): TWindow;
protected
public
function Add(AWindow: TWindow): Integer; reintroduce;
property Window[AIndex: Integer]: TWindow read GetWindow; default;
end;
TProcessList = class(TObjectList)
protected
function GetProcess(AIndex: Integer): TProcess;
public
function Add(AProcess: TProcess): Integer; reintroduce;
property Process[AIndex: Integer]: TProcess read GetProcess; default;
end;
TWindows = class(TObject)
protected
public
class function GetHWNDFromProcessID(ProcessID: Cardinal; BuildList: Boolean = True): THandle;
class function GetProcessList: TProcessList;
class procedure KillProcess(ProcessName: string);
class procedure StopProcess(ProcessName: string);
class function ExeIsRunning(ExeName: string): Boolean;
class function ProcessIsRunning(PID: Cardinal): Boolean;
end;
implementation
uses
Forms,
Math,
PSAPI,
TlHelp32;
const
cRSPUNREGISTERSERVICE = 0;
cRSPSIMPLESERVICE = 1;
type
TProcessToHWND = class(TObject)
public
ProcessID: Cardinal;
HWND: Cardinal;
end;
function RegisterServiceProcess(dwProcessID, dwType: DWord): DWord; stdcall; external 'KERNEL32.DLL';
function GetDiskFreeSpaceEx(lpDirectoryName: PChar;
var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: TLargeInteger;
lpTotalNumberOfFreeBytes: PLargeInteger): Boolean; stdcall;external 'KERNEL32.DLL' name 'GetDiskFreeSpaceExA'
var
GProcessToHWNDList: TObjectList = nil;
function EnumerateWindowsProc(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
proc: TProcessToHWND;
begin
if Assigned(GProcessToHWNDList) then
begin
proc := TProcessToHWND.Create;
proc.HWND := hwnd;
GetWindowThreadProcessID(hwnd, proc.ProcessID);
GProcessToHWNDList.Add(proc);
Result := True;
end
else
Result := False; // stop enumeration
end;
{ TWindows }
class function TWindows.ExeIsRunning(ExeName: string): Boolean;
var
processList: TProcessList;
i: Integer;
begin
Result := False;
processList := GetProcessList;
try
for i := 0 to processList.Count - 1 do
begin
if (UpperCase(ExeName) = UpperCase(processList[i].Name)) or
(UpperCase(ExeName) = UpperCase(ExtractFileName(processList[i].Name))) then
begin
Result := True;
Break;
end;
end;
finally
processList.Free;
end;
end;
class function TWindows.GetHWNDFromProcessID(
ProcessID: Cardinal; BuildList: Boolean): THandle;
var
i: Integer;
begin
Result := 0;
if BuildList or (not Assigned(GProcessToHWNDList)) then
begin
GProcessToHWNDList.Free;
GProcessToHWNDList := TObjectList.Create;
EnumWindows(@EnumerateWindowsProc, 0);
end;
for i := 0 to GProcessToHWNDList.Count - 1 do
begin
if TProcessToHWND(GProcessToHWNDList[i]).ProcessID = ProcessID then
begin
Result := TProcessToHWND(GProcessToHWNDList[i]).HWND;
Break;
end;
end;
end;
class function TWindows.GetProcessList: TProcessList;
var
handle: THandle;
pe: TProcessEntry32;
process: TProcess;
begin
Result := TProcessList.Create;
handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
pe.dwSize := Sizeof(pe);
if Process32First(handle, pe) then
begin
while True do
begin
process := TProcess.Create;
process.Name := pe.szExeFile;
process.ID := pe.th32ProcessID;
Result.Add(process);
if not Process32Next(handle, pe) then
Break;
end;
end;
CloseHandle(handle);
end;
function EnumWindowsProc(Ahwnd : HWND; // handle to parent window
ALParam : Integer) : BOOL;stdcall;
var
List : TWindowList;
Wnd : TWindow;
begin
Result := True;
List := TWindowList(ALParam);
Wnd := TWindow.Create;
List.Add(Wnd);
Wnd.FHandle := Ahwnd;
end;
class procedure TWindows.KillProcess(ProcessName: string);
var
handle: THandle;
pe: TProcessEntry32;
begin
// Warning: will kill all process with ProcessName
// NB won't work on NT 4 as Tool Help API is not supported on NT
handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
try
pe.dwSize := Sizeof(pe);
if Process32First(handle, pe) then
begin
while True do begin
if (UpperCase(ExtractFileName(pe.szExeFile)) = UpperCase(ExtractFileName(ProcessName))) or
(UpperCase(pe.szExeFile) = UpperCase(ProcessName)) then
begin
if not TerminateProcess(OpenProcess(PROCESS_TERMINATE, False,
pe.th32ProcessID), 0) then
begin
raise Exception.Create('Unable to stop process ' + ProcessName + ': Error Code ' + IntToStr(GetLastError));
end;
end;
if not Process32Next(handle, pe) then
Break;
end;
end;
finally
CloseHandle(handle);
end;
end;
class function TWindows.ProcessIsRunning(PID: Cardinal): Boolean;
var
processList: TProcessList;
i: Integer;
begin
Result := False;
processList := GetProcessList;
try
for i := 0 to processList.Count - 1 do
begin
if processList[i].ID = PID then
begin
Result := True;
Break;
end;
end;
finally
processList.Free;
end;
end;
class procedure TWindows.StopProcess(ProcessName: string);
var
processList: TProcessList;
i: Integer;
hwnd: THandle;
begin
// Warning: will attempt to stop all process with ProcessName
if not Assigned(GProcessToHWNDList) then
GProcessToHWNDList := TObjectList.Create
else
GProcessToHWNDList.Clear;
// get list of all current processes
processList := GetProcessList;
// enumerate windows only once to determine the window handle for the processes
if EnumWindows(@EnumerateWindowsProc, 0) then
begin
for i := 0 to processList.Count - 1 do
begin
if UpperCase(ExtractFileName(processList[i].Name)) = UpperCase(ExtractFileName(ProcessName)) then
begin
hwnd := GetHWNDFromProcessID(processList[i].ID, False);
SendMessage(hwnd, WM_CLOSE, 0, 0);
end;
end;
end;
end;
{ TProcessList }
function TProcessList.Add(AProcess: TProcess): Integer;
begin
Result := inherited Add(AProcess);
end;
function TProcessList.GetProcess(AIndex: Integer): TProcess;
begin
Result := TProcess(Items[AIndex]);
end;
{ TWindowList }
function TWindowList.Add(AWindow: TWindow): Integer;
begin
Result := inherited Add(AWindow);
end;
function TWindowList.GetWindow(AIndex: Integer): TWindow;
begin
Result := TWindow(Items[AIndex]);
end;
{ TWindow }
function TWindow.GetProcessHandle: THandle;
begin
if FProcessHandle = 0 then
FProcessHandle := OpenProcess(Windows.SYNCHRONIZE or Windows.PROCESS_TERMINATE,
True, FProcessID);
Result := FProcessHandle;
end;
function TWindow.GetProcessID: Cardinal;
var
Pid : Cardinal;
begin
if FProcessID = 0 then
begin
Pid := 1;
GetWindowThreadProcessId(Handle, Pid);
FProcessID := Pid;
end;
Result := FProcessID;
end;
function TWindow.GetProcessName: string;
var
Buffer : packed array [1..1024] of char;
len : LongWord;
begin
FillChar(Buffer, SizeOf(Buffer), 0);
if FProcessName = '' then
begin
len := GetWindowModuleFileName(Handle, @Buffer[1], 1023);
FProcessName := Copy(Buffer, 1, Len);
end;
Result := FProcessName;
end;
end.