#!/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 before 
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.