package Win32::KillProcess;

use 5.006;
use strict;
use warnings;
use Win32::OLE;
use Win32::OLE::Variant;

require Exporter;

use vars qw( @ISA %EXPORT_TAGS @EXPORT $VERSION );
@ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw(
    connectServer
    killProcess
    startProcess
    showRunningProcess
    getProcessPids
    showRunningService
    getServicePids
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
$VERSION = '0.01';

sub connectServer {
    my ( $server, $username, $password ) = @_;
    $server ||= '.';  # localhost
    my $locator = Win32::OLE->new("WbemScripting.SWbemLocator") 
        or die "Can't access WMI on local machine.", Win32::OLE->LastError;
    my $serverConn = $locator->ConnectServer($server, "root/cimv2", $username, $password) 
        or     die "Can't access WMI on remote machine $server: ", Win32::OLE->LastError;
  return $serverConn;
}

sub killProcess {
    my ( $serverConn, @pids ) = @_;
  return unless @pids;
    for my $pid( @pids ) {
        my $obj = $serverConn->Get( "Win32_Process.Handle=$pid" ) 
            or do { print "Could not get an object handle for $pid: ", Win32::OLE->LastError; next };
        my $retval = $obj->Terminate();
        $retval && warn "Could not kill $pid: " . decode_error($retval);
        undef $obj;
    }
}

sub startProcess {
    my ( $serverConn, $exe, $startupFolder ) = @_;
    my $startClass = $serverConn->Get("Win32_Process") or die Win32::OLE->LastError;
    my $startConfig = $startClass->SpawnInstance_ ;
    my $pid = Variant(VT_I4|VT_BYREF, 0);
    my $retval = $startClass->Create( $exe, $startupFolder, undef, $pid );
    if ( 0 == $retval  ) {
        return $pid;
    }
    else {
        die "Could not start $exe errcode: " . decode_error($retval);
    }
}

sub decode_error {
    my %h = (
        1	=>	"Not Supported",
        2	=>	"Access Denied",
        3	=>	"Dependent Services Running",
        4	=>	"Invalid Service Control",
        5	=>	"Service Cannot Accept Control",
        6	=>	"Service Not Active",
        7	=>	"Service Request Timeout",
        8	=>	"Unknown Failure",
        9	=>	"Path Not Found",
        10	=>	"Service Already Running",
        11	=>	"Service Database Locked",
        12	=>	"Service Dependency Deleted",
        13	=>	"Service Dependency Failure",
        14	=>	"Service Disabled",
        15	=>	"Service Logon Failure",
        16	=>	"Service Marked For Deletion",
        17	=>	"Service No Thread",
        18	=>	"Status Circular Dependency",
        19	=>	"Status Duplicate Name",
        20	=>	"Status Invalid Name",
        21	=>	"Status Invalid Parameter",
        22	=>	"Status Invalid Service Account",
        23	=>	"Status Service Exists",
        24	=>	"Service Already Paused",
    );
  return $h{$_[0]} ? $h{$_[0]} : "Can't resolve error code $_[0]";
}


sub showRunningService {
    my $serverConn = shift;
    my $serviceSet = $serverConn->ExecQuery('SELECT * FROM Win32_Service WHERE State="Running"')
        or die "Can't get process list from server: " . Win32::OLE->LastError;
    for my $service ( in $serviceSet ) {
        printf "%s\n\tPID: %-6d  Start Mode: %s\n\n",
            $service->{Description}, $service->{ProcessId},$service->{StartMode};
    }
}

sub showRunningProcess {
    my $serverConn = shift;
    my $processSet = $serverConn->ExecQuery('SELECT * FROM Win32_Process')
        or die "Can't get process list from server: ", Win32::OLE->LastError;
    for my $process ( in $processSet ) {
        printf "%-6d  %s\n", $process->{ProcessId}, $process->{Description};
    }
}

sub getServicePids {
    my ( $serverConn, $description ) = @_;
    $description = lc($description);
    my @pids;
    my $serviceSet = $serverConn->ExecQuery('SELECT * FROM Win32_Service WHERE State="Running"')
        or die "Can't get process list from server: ", Win32::OLE->LastError;
    for my $service ( in $serviceSet ) {
        push @pids, $service->{ProcessId} if $description eq lc($service->{Description});
    }
  return @pids;
}

sub getProcessPids {
    my ( $serverConn, $description ) = @_;
    $description = lc($description);
    my @pids;
    my $processSet = $serverConn->ExecQuery('SELECT * FROM Win32_Process')
        or die "Can't get process list from server: ", Win32::OLE->LastError;
    for my $process ( in $processSet ) {
        push @pids, $process->{ProcessId} if $description eq lc($process->{Description});
    }
  return @pids;
}

1;
__END__

=head1 NAME

Win32::KillProcess - Perl extension for viewing and killing processes

=head1 SYNOPSIS

  use Win32::KillProcess ':all';
  # connect to localhost as logged in user
  $c = connectServer(); 
  # connect to any server (local/remote) using username and password
  my $c = connectServer( $servername, $username, $password );
  showRunningProcess($c);
  showRunningService($c);
  my @pids = getProcessPids( $c, 'wordpad.exe' );
  killProcess( $c, @pids );
  my $pid = startProcess( $c, "C:\\WINNT\\system32\\dllcache\\wordpad.exe" );

=head1 DESCRIPTION

Win32::KillProcess lets you connect to a server (localhost or remote), view 
the running services and processes, get PIDs based on service/process name,
and of course kill them dead. You can also start local or remote processes.

For more details RTFS. This module uses Win32::OLE to talk to native 
Windows WMI which actually does the dirty work.

=head2 EXPORT

None by default.

=head1 AUTHOR

Dr James Freeman, E<lt>james.freeman@id3.org.uk<gt>

=head1 SEE ALSO

L<perl>.

=cut