Delphi 中关闭指定进程的方法

  1. Uses
  2. Windows,
  3. SysUtils,
  4. Tlhelp32 ;
  5. Function KillTask( ExeFileName: String ): Integer ; //关闭进程
  6. Function EnableDebugPrivilege: Boolean ; //提升权限
  7. Function FindProcessId( ExeFileName: String ): THandle ; //查找进程
  8. Implementation
  9. Function FindProcessId( ExeFileName: String ): THandle ;
  10. Var
  11. ContinueLoop: BOOL ;
  12. FSnapshotHandle: THandle ;
  13. FProcessEntry32: TProcessEntry32 ;
  14. Begin
  15. result := 0 ;
  16. FSnapshotHandle := CreateToolhelp32Snapshot( TH32CS_SNAPPROCESS, 0 ) ;
  17. FProcessEntry32.dwSize := Sizeof( FProcessEntry32 ) ;
  18. ContinueLoop := Process32First( FSnapshotHandle, FProcessEntry32 ) ;
  19. While integer( ContinueLoop ) <> 0 Do
  20. Begin
  21. If UpperCase( FProcessEntry32.szExeFile ) = UpperCase( ExeFileName ) Then
  22. Begin
  23. result := FProcessEntry32.th32ProcessID ;
  24. break ;
  25. End ;
  26. ContinueLoop := Process32Next( FSnapshotHandle, FProcessEntry32 ) ;
  27. End ;
  28. CloseHandle( FSnapshotHandle ) ;
  29. End ;
  30. Function KillTask( ExeFileName: String ): Integer ;
  31. Const
  32. PROCESS_TERMINATE = $0001 ;
  33. Var
  34. ContinueLoop: boolean ;
  35. FSnapshotHandle: THandle ;
  36. FProcessEntry32: TProcessEntry32 ;
  37. Begin
  38. Result := 0 ;
  39. FSnapshotHandle := CreateToolhelp32Snapshot( TH32CS_SNAPPROCESS, 0 ) ;
  40. FProcessEntry32.dwSize := SizeOf( FProcessEntry32 ) ;
  41. ContinueLoop := Process32First( FSnapshotHandle, FProcessEntry32 ) ;
  42. While Integer( ContinueLoop ) <> 0 Do
  43. Begin
  44. If ( ( UpperCase( ExtractFileName( FProcessEntry32.szExeFile ) ) =
  45. UpperCase( ExeFileName ) ) Or ( UpperCase( FProcessEntry32.szExeFile ) =
  46. UpperCase( ExeFileName ) ) ) Then
  47. Result := Integer( TerminateProcess(
  48. OpenProcess( PROCESS_TERMINATE,
  49. BOOL( 0 ),
  50. FProcessEntry32.th32ProcessID ),
  51. 0 ) ) ;
  52. ContinueLoop := Process32Next( FSnapshotHandle, FProcessEntry32 ) ;
  53. End ;
  54. CloseHandle( FSnapshotHandle ) ;
  55. End ;
  56. //但是对于服务程序,它会提示"拒绝访问".其实只要程序拥有Debug权限即可:
  57. Function EnableDebugPrivilege: Boolean ;
  58. Function EnablePrivilege( hToken: Cardinal ;PrivName: String ;bEnable: Boolean ): Boolean ;
  59. Var
  60. TP: TOKEN_PRIVILEGES ;
  61. Dummy: Cardinal ;
  62. Begin
  63. TP.PrivilegeCount := 1 ;
  64. LookupPrivilegeValue( Nil, pchar( PrivName ), TP.Privileges[ 0 ].Luid ) ;
  65. If bEnable Then
  66. TP.Privileges[ 0 ].Attributes := SE_PRIVILEGE_ENABLED
  67. Else
  68. TP.Privileges[ 0 ].Attributes := 0 ;
  69. AdjustTokenPrivileges( hToken, False, TP, SizeOf( TP ), Nil, Dummy ) ;
  70. Result := GetLastError = ERROR_SUCCESS ;
  71. End ;
  72. Var
  73. hToken: Cardinal ;
  74. Begin
  75. OpenProcessToken( GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken ) ;
  76. result := EnablePrivilege( hToken, 'SeDebugPrivilege', True ) ;
  77. CloseHandle( hToken ) ;
  78. End ;
  79. End.