Delphi 中关闭指定进程的方法

Uses
  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.