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

Win32SnapWalk

by t0mas (Priest)
on Jul 10, 2000 at 17:16 UTC ( [id://21783]=sourcecode: print w/replies, xml ) Need Help??
Category: Win32 Stuff
Author/Contact Info t0mas@netlords.net
Description: A package to list the currently running processes on a Win32 box. It uses Win32::API.
#!/usr/local/bin/perl -w
#
# Win32SnapWalk package
# by t0mas@netlords.net
#

package Win32SnapWalk;

use strict;
use Win32::API;

use constant TH32CS_SNAPPROCESS => 0x00000002;
use constant DWORD_SIZE => 4;
use constant LONG_SIZE => 4;
use constant MAX_PATH_SIZE => 260;

######################################################################
sub GetProcessList { 

    #
    # Get list of processes, return as an array of hashes
    #

    my $hProcessSnap; 
    my $pe32; 
    my @pList;
    my $process;
 
    # Import required functions
    my $CreateToolhelp32Snapshot = new Win32::API(
        "kernel32", 
        "CreateToolhelp32Snapshot", 
        ["N", "N"], 
        "I");

    if (! defined $CreateToolhelp32Snapshot) {
        die "Can't import CreateToolhelp32Snapshot";
    }

    my $Process32First = new Win32::API(
        "kernel32", 
        "Process32First", 
        ["I", "P"], 
        "I");

    if (! defined $Process32First) {
        die "Can't import Process32First";
    }


    my $Process32Next = new Win32::API(
        "kernel32", 
        "Process32Next", 
        ["I", "P"], 
        "I");

    if (! defined $Process32Next) {
        die "Can't import Process32Next";
    }

    my $CloseHandle = new Win32::API(
        "kernel32", 
        "CloseHandle", 
        ["I"], 
        "V");

    if (! defined $CloseHandle) {
        die "Can't import CloseHandle";
    }

    # Take a snapshot of all processes in the system. 
    $hProcessSnap = $CreateToolhelp32Snapshot->Call(TH32CS_SNAPPROCESS
+, 0); 

    if (! $hProcessSnap) {
        die "Unable to get process list";
    } 

    # Fill in the size of the structure with blanks before using it. 
    # Should be sizeof(PROCESSENTRY32) but I just guess here...; 
    $pe32 = " " x (DWORD_SIZE*8+LONG_SIZE+MAX_PATH_SIZE); 
 
    #  Walk the snapshot of the processes, and for each process, 
    #  push to list. 
    if ($Process32First->Call($hProcessSnap, $pe32)) {

        do {
            # Empty hash
            $process={};

            # Unpack structure to hash
            ($process->{dwSize},
            $process->{cntUsage},
            $process->{th32ProcessID},
            $process->{th32DefaultHeapID},
            $process->{th32ModuleID},
            $process->{cntThreads},
            $process->{th32ParentProcessID},
            $process->{pcPriClassBase},
            $process->{dwFlags},
            $process->{szExeFile}) = unpack("LLLLLLLlLA*",$pe32);

            # Push process to list
            push(@pList,$process); 

            # Fill in the size of the structure again with blanks. 
            $pe32 = " " x (DWORD_SIZE*8+LONG_SIZE+MAX_PATH_SIZE); 

        } while ($Process32Next->Call($hProcessSnap, $pe32)); 
    }

    # Close handle
    $CloseHandle->Call($hProcessSnap);

    # Return process list
    return @pList;
};
 
######################################################################
1;

__END__


=head1 NAME

Win32SnapWalk - List processes running on a Win32 box

=head1 DESCRIPTION

A package that lists processes running on a Win32 box.

=head1 SYNOPSIS

Example:

 #!/usr/local/bin/perl -w
 use Win32SnapWalk;

 my @processes=Win32SnapWalk::GetProcessList();

 for my $href ( @processes ) {
    print "{\n";
    for my $name ( keys %$href ) {
       print "  $name=$href->{$name}\n";
    }
    print "}\n";
 }

=head1 SEE ALSO

L<Win32::API>

=head1 BUGS

The hash element dwSize is wrong and meaningless. Its supposed to hold
+ the size
of the process structure (sizeof(PROCESSENTRY32)) and shold be set bef
+ore 
calling Process32First if you do it in C/C++.

This package is only tested on Win2k, and it may behave faulty on the 
+other 
Win* flavours 

Probably a few...  

=head1 FUTURE DEVELOPMENT

Module, heap, and thread walking seems like logical improvements.

=head1 DISCLAIMER

I do not guarantee B<ANYTHING> with this package. If you use it you
are doing so B<AT YOUR OWN RISK>! I may or may not support this
depending on my time schedule...

=head1 AUTHOR

t0mas@netlords.net

=head1 COPYRIGHT

Copyright 1999-2000, t0mas@netlords.net

This package is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (7)
As of 2024-03-19 01:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found