Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Win32::KillProcess

by tachyon (Chancellor)
on Mar 11, 2004 at 23:22 UTC ( #336024=sourcecode: print w/replies, xml ) Need Help??
Category: Win32
Author/Contact Info Dr James Freeman
Description: Enumerate, start and kill remote (or local) processes on Win32
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
Replies are listed 'Best First'.
Re: Win32::KillProcess
by maa (Pilgrim) on Mar 31, 2004 at 08:02 UTC

    tachyon,

    thanks to @dawn in her node Re: Re: Win32::OLE (Variants by reference) we can now get the PID when we create the process. I had tried this vefore but she jogged my memory... we need to pass a Variant by Reference!

    my $Startup_Class = $wmihandle->Get("Win32_ProcessStartup"); my $Startup_Config = $Startup_Class->SpawnInstance_ ; my ($error, $pid, $startup_folder); $startup_folder="C:\\TEMP\\"; $pid= Variant(VT_I4|VT_BYREF, 0); if (0 == $wmiprocesses->Create($command_path,$startup_folder,$Startup_ +Config,$pid) ) { if ($pid) { print "pid=$pid\n"; } #blah blah blah

    I've tested this and it works a treat! Thanks @dawn for pointing out obvious thing we missed in the WMI docs.

    - Mark
Re: Win32::KillProcess
by Anonymous Monk on Mar 12, 2004 at 11:24 UTC
    wonderfull!!!

    how can I launch on a remote pc a perl scripts with argoument?

      You need perl installed on the remote machine to run perl scripts on it. If it is, say on G:

      use Win32::KillProcess qw( connectServer startProcess ); my $c = connectServer( $server, $user, $pass ); startProcess( $c, "G:\\perl\\bin\\perl.exe C:\\test.pl command line ar +gs" );

      cheers

      tachyon

        I am running this code which works great except for one thing. When I try to execute a non existing exe it still returns 0 and a pid. Why is that? Thanks, boat73
Re: Win32::KillProcess
by jdtoronto (Prior) on Mar 12, 2004 at 15:55 UTC
    Luckily I don't need it! But this looks really great and is a great contribution. Thanks tachyon
Re: Win32::KillProcess
by Anonymous Monk on Mar 12, 2004 at 11:32 UTC
    it never return the pid colling create process ?!?!

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://336024]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (3)
As of 2021-10-24 14:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (89 votes). Check out past polls.

    Notices?