I left off an * on the pack:

my $PE32 = pack 'LLLLLLLLLZ*', 296, 0, 0, 0, 0, 0, 0, 0, 0, ' ' x 259 . "\0";
print Data::Dumper->Dump([$PE32], [qw($PE32)]) if $debug;

Also, you're requesting thread and dumping process.  You should
request ALL or dump thread instead of process.

use strict;
use warnings;
use Win32::API;

# HANDLE WINAPI CreateToolhelp32Snapshot(DWORD dwFlags, DWORD th32ProcessID);

Win32::API->Import('kernel32',
  'HANDLE CreateToolhelp32Snapshot(DWORD dwFlags, DWORD th32ProcessID)')
  or die "import CreateToolhelp32Snapshot: $!($^E)";

use constant TH32CS_SNAPHEAPLIST => 0x1;
use constant TH32CS_SNAPPROCESS => 0x2;
use constant TH32CS_SNAPTHREAD => 0x4;
use constant TH32CS_SNAPMODULE => 0x8;
use constant TH32CS_SNAPALL => TH32CS_SNAPHEAPLIST | TH32CS_SNAPPROCESS |
  TH32CS_SNAPTHREAD | TH32CS_SNAPMODULE;

my $hProcessSnap = CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS, 0);
die "CreateToolhelp32Snapshot: $!($^E)" if $hProcessSnap == -1;
print Data::Dumper->Dump([$hProcessSnap], [qw($hProcessSnap)]);

my $PE32 = pack 'LLLLLLLLLZ*', 296, 0, 0, 0, 0, 0, 0, 0, 0, ' ' x 259 . "\0";
print Data::Dumper->Dump([$PE32], [qw($PE32)]) if $debug;

# BOOL WINAPI Process32First(HANDLE hSnapshot, LPPROCESSENTRY32 lppe);

Win32::API->Import('kernel32', 'Process32First', 'IP', 'I') or
  die "import CreateToolhelp32Snapshot: $!($^E)";

my $ret = Process32First ($hProcessSnap, $PE32) or
  die "Process32First: $! $(^E)";
my @PE32 = unpack 'LLLLLLLLLZ*', $PE32;
formatprint (@PE32);
print Data::Dumper->Dump([$ret, [EMAIL PROTECTED], [qw($ret [EMAIL 
PROTECTED])]) if $debug;

# BOOL WINAPI Process32Next (HANDLE hSnapshot, LPPROCESSENTRY32 lppe);

Win32::API->Import('kernel32', 'Process32Next', 'IP', 'I') or
  die "import CreateToolhelp32Snapshot: $!($^E)";

use constant ERROR_NO_MORE_FILES => 18;

while (1) {
        $ret = Process32Next ($hProcessSnap, $PE32);
        if ($ret == 0) {
                if (Win32::GetLastError() == ERROR_NO_MORE_FILES) {
                        print "No more files (all is well)\n";
                        last;
                } else {
                        die "Process32Next: $!($^E)";
                }
        }
        my @PE32 = unpack 'LLLLLLLLLZ*', $PE32;
        formatprint (@PE32);
        print Data::Dumper->Dump([$ret, [EMAIL PROTECTED], [qw($ret [EMAIL 
PROTECTED])]) if $debug;
}
print "Done\n";

#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub formatprint {

print "\tdwSize=", $_[0], "\n";
print "\tcntUsage=", $_[1], "\n";
print "\tth32ProcessID=", $_[2], "\n";
print "\tth32DefaultHeapID=", $_[3], "\n";
print "\tth32ModuleID=", $_[4], "\n";
print "\tcntThreads=", $_[5], "\n";
print "\tth32ParentProcessID=", $_[6], "\n";
print "\tpcPriClassBase=", $_[7], "\n";
print "\tdwFlags=", $_[8], "\n";
print "\tszExeFile=", $_[9], "\n";
print "\n";

}

__END__
_______________________________________________
Perl-Win32-Users mailing list
Perl-Win32-Users@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs

Reply via email to