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->LastE
+rror;
    my $serverConn = $locator->ConnectServer($server, "root/cimv2", $u
+sername, $password) 
        or     die "Can't access WMI on remote machine $server: ", Win
+32::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::O
+LE->LastError;
    my $startConfig = $startClass->SpawnInstance_ ;
    my $pid = Variant(VT_I4|VT_BYREF, 0);
    my $retval = $startClass->Create( $exe, $startupFolder, undef, $pi
+d );
    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_Servi
+ce WHERE State="Running"')
        or die "Can't get process list from server: " . Win32::OLE->La
+stError;
    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_Proce
+ss')
        or die "Can't get process list from server: ", Win32::OLE->Las
+tError;
    for my $process ( in $processSet ) {
        printf "%-6d  %s\n", $process->{ProcessId}, $process->{Descrip
+tion};
    }
}

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

sub getProcessPids {
    my ( $serverConn, $description ) = @_;
    $description = lc($description);
    my @pids;
    my $processSet = $serverConn->ExecQuery('SELECT * FROM Win32_Proce
+ss')
        or die "Can't get process list from server: ", Win32::OLE->Las
+tError;
    for my $process ( in $processSet ) {
        push @pids, $process->{ProcessId} if $description eq lc($proce
+ss->{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 proce
+sses.

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