本文整理自网络,侵删。
unit ProcUtils;
interfaceuses Windows, SysUtils, Tlhelp32;
function KillTask(ExeFileName: string): Integer; //关闭进程function EnableDebugPrivilege: Boolean; //提升权限function FindProcessId(ExeFileName: string): THandle; //查找进程
implementation
function FindProcessId(ExeFileName: string): THandle;var ContinueLoop: BOOL; FSnapshotHandle: THandle; FProcessEntry32: TProcessEntry32;begin result := 0; FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); FProcessEntry32.dwSize := Sizeof(FProcessEntry32); ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); while integer(ContinueLoop) <> 0 do begin if UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName) then begin result := FProcessEntry32.th32ProcessID; break; end; ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); end; CloseHandle(FSnapshotHandle);end;
function KillTask(ExeFileName: string): Integer;const PROCESS_TERMINATE = $0001;var ContinueLoop: boolean; FSnapshotHandle: THandle; FProcessEntry32: TProcessEntry32;begin Result := 0; FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); FProcessEntry32.dwSize := SizeOf(FProcessEntry32); ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); while Integer(ContinueLoop) <> 0 do begin if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then Result := Integer(TerminateProcess( OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0)); ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); end; CloseHandle(FSnapshotHandle);end;//但是对于服务程序,它会提示"拒绝访问".其实只要程序拥有Debug权限即可:
function EnableDebugPrivilege: Boolean; function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean; var TP: TOKEN_PRIVILEGES; Dummy: Cardinal; begin TP.PrivilegeCount := 1; LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid); if bEnable then TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED else TP.Privileges[0].Attributes := 0; AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy); Result := GetLastError = ERROR_SUCCESS; end;var hToken: Cardinal;begin// OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken); result := EnablePrivilege(hToken, '\SeDebugPrivilege\', True); CloseHandle(hToken);end;end.
相关阅读 >>
Delphi 解决Delphi indy10下 utf8码转换的问题
Delphi关于dbgrid和webbrowser的焦点问题
更多相关阅读请进入《Delphi》频道 >>