getppid() on Windows

This is a multi-part message in MIME format.

--===============0670094597==
content-class: urn:content-classes:message
Content-Type: multipart/alternative;
boundary="----_=_NextPart_001_01C78DD1.3BE8DA7A"

This is a multi-part message in MIME format.

------_=_NextPart_001_01C78DD1.3BE8DA7A
Content-Type: text/plain;
charset="us-ascii"
Content-Transfer-Encoding: quoted-printable

=20

Is there a way to get the parent process id of a Windows process just
like getppid() (since getppid() doesn't seem to be implemented in
ActiveState perl)?

=20

Sincerely,

James Couball


------_=_NextPart_001_01C78DD1.3BE8DA7A
Content-Type: text/html;
charset="us-ascii"
Content-Transfer-Encoding: quoted-printable

xmlns:o=3D"urn:schemas-microsoft-com:office:office" =
xmlns:w=3D"urn:schemas-microsoft-com:office:word" =
xmlns=3D"http://www.w3.org/TR/REC-html40">


charset=3Dus-ascii">

RE: getppid() on Windows

This is a multi-part message in MIME format.

--===============1192138264==
Content-class: urn:content-classes:message
Content-Type: multipart/alternative;
boundary="----_=_NextPart_001_01C78DD2.46259FD8"

This is a multi-part message in MIME format.

------_=_NextPart_001_01C78DD2.46259FD8
Content-Type: text/plain;
charset="us-ascii"
Content-Transfer-Encoding: quoted-printable

Try:=20

### Getting the parent process id using WMI ###

# Get the WMI root on the users machine

my $ppid;

my $objWMIService =3D
Win32::OLE->GetObject("winmgmts:\\\\.\\root\\CIMV2");

if ( defined($objWMIService) ) {

# Get the object corresponding to Win32_Process where process id
is the current process =20

my $objProcessList =3D $objWMIService->ExecQuery("Select
ParentProcessId from Win32_Process WHERE ProcessId =3D $$");

if (defined($objProcessList)) {

# Get the parent process ids

foreach my $prsObj (in($objProcessList)) {

$ppid =3D $prsObj->ParentProcessId;

last;

} =20

}

}

=20

________________________________

From: activeperl-bounces@listserv.ActiveState.com
[mailto:activeperl-bounces@listserv.ActiveState.com] On Behalf Of James
Couball
Sent: Thursday, May 03, 2007 3:20 PM
To: activeperl@listserv.ActiveState.com
Subject: getppid() on Windows

=20

=20

Is there a way to get the parent process id of a Windows process just
like getppid() (since getppid() doesn't seem to be implemented in
ActiveState perl)?

=20

Sincerely,

James Couball


------_=_NextPart_001_01C78DD2.46259FD8
Content-Type: text/html;
charset="us-ascii"
Content-Transfer-Encoding: quoted-printable




charset=3Dus-ascii">

RE: getppid() on Windows

Everyone, thank you for the replies.

Here is what I ended up with for a getppid that works platforms that
support getppid() and Windows (comments welcome):

sub _getppid() {

my $ppid;

if ($^O =~ /^MSWin/) {
my $pid = $$;
my $machine = "\\\\.";

require Win32::OLE;
require Win32::OLE::Variant;

# WMI Win32_Process class
my $class =
"winmgmts:{impersonationLevel=impersonate}$machine\\Root\\ci mv2";
if (my $wmi = Win32::OLE->GetObject($class)) {
if(my $proc=$wmi->Get(qq{Win32_Process.Handle="$pid"})) {
$ppid = $proc->{ParentProcessId} if
($proc->{ParentProcessId}!=0);
}
}
}
else {
$ppid = getppid();
}

return $ppid;
}



________________________________________
From: activeperl-bounces@listserv.ActiveState.com
[mailto:activeperl-bounces@listserv.ActiveState.com] On Behalf Of James
Couball
Sent: Thursday, May 03, 2007 3:20 PM
To: activeperl@listserv.ActiveState.com
Subject: getppid() on Windows


Is there a way to get the parent process id of a Windows process just
like getppid() (since getppid() doesn't seem to be implemented in
ActiveState perl)?

Sincerely,
James Couball

_______________________________________________
ActivePerl mailing list
ActivePerl@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs

Re: getppid() on Windows

On 5/4/07, James Couball wrote:

> Here is what I ended up with for a getppid that works platforms that
> support getppid() and Windows (comments welcome):
>

Just remember that the parent process may already have exited. Windows
doesn't have the same notion of a parent-child relationship that Unix.

What do you intend to do with the parent process id?

-
Sriram
www.sriramkrishnan.com
_______________________________________________
ActivePerl mailing list
ActivePerl@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs

Re: getppid() on Windows

James Couball wrote:
> Everyone, thank you for the replies.
>
> Here is what I ended up with for a getppid that works platforms that
> support getppid() and Windows (comments welcome):

Just for comparison, here's a script that compares your OLE version to a
Win32::API version - the API version is a bit longer, but should be much
faster. I couldn't get either method to fail if parent has exited (or at
least attempted to exit using script at end and uncommenting BEGIN line
below) :

#!perl --

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

# make sure we're detached from parent for this test and log ppid to foo
# this next line is attempting to have parent exit before this runs
# BEGIN { open STDOUT, ">>$ENV{TMP}/foo"; binmode STDOUT; $| = 1; sleep 5; }

our ($pt0, $timeit);
BEGIN { $timeit = 1; } # time the script
BEGIN { if ($timeit) { print scalar (localtime), "\n";
$pt0 = Win32::GetTickCount (); } }
END { if ($timeit) { print scalar (localtime); my $ticks = Win32::GetTickCount;
printf " - %.6f sec (%u ticks)\n", ($ticks - $pt0) / 1000, $ticks - $pt0; } }

our %A; # get commandline switches into %A
for (my $ii = 0; $ii < @ARGV; ) {
if ($ARGV[$ii] =~ /^--$/) { splice @ARGV, $ii, 1; last; }
if ($ARGV[$ii] !~ /^-{1,2}(.*)$/) { $ii++; next; }
my $arg = $1; splice @ARGV, $ii, 1;
if ($arg =~ /^([\w]+)=(.*)$/) { exists ($A{$1}) ? ($A{$1} .= "|$2") :
($A{$1} = $2); } else { $A{$1}++; }
}

my $ole = $A{o} || 0; # get switches to vars
my $api = $A{a} || 0; $api = 1 if not $ole;

(my $prog = $0) =~ s/^.*[\\\/]//; # usage printout
my $usage = <
Usage: $prog [-a] [-o]
-a use Win32::API (default)
-o use OLE instead of API

EOD
die $usage if $A{h} or $A{help};

my $CreateToolhelp32Snapshot; # define API calls
my $Process32First;
my $Process32Next;
my $CloseHandle;

my $ppid;
if ($^O =~ /^MSWin/) {
if ($ole) {
$ppid = getppido (); # use OLE to get it
} elsif ($api) {
$ppid = getppida (); # use Win32::API to get it
}
} else {
$ppid = getppid ();
}
printf "OLE=%u, API=%u, pid='%d', ppid='%d'\n", $ole, $api, $$, defined
$ppid ? $ppid : '';
exit;

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

sub getppido { # OLE version
require Win32::OLE;
require Win32::OLE::Variant;

my $machine = "\\\\.";
# WMI Win32_Process class
my $class = "winmgmts:{impersonationLevel=impersonate}$machine\\Root\\ci mv2";

my $ppid;
if (my $wmi = Win32::OLE->GetObject($class)) {
my $pid = $$;
if (my $proc=$wmi->Get(qq{Win32_Process.Handle="$pid"})) {
$ppid = $proc->{ParentProcessId} if
($proc->{ParentProcessId}!=0);
}
}
return $ppid;

}

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

sub getppida { # Win32::API version

if (not defined $CreateToolhelp32Snapshot) {
$CreateToolhelp32Snapshot = new Win32::API ('kernel32',
'CreateToolhelp32Snapshot', 'II', 'N') or
die "import CreateToolhelp32Snapshot: $!($^E)";
$Process32First = new Win32::API ('kernel32', 'Process32First',
'IP', 'N') or die "import Process32First: $!($^E)";
$Process32Next = new Win32::API ('kernel32', 'Process32Next', 'IP',
'N') or die "import Process32Next: $!($^E)";
$CloseHandle = new Win32::API ('kernel32', 'CloseHandle', 'I', 'N')
or die "import CloseHandle: $!($^E)";
}

use constant TH32CS_SNAPPROCESS => 0x00000002;
use constant INVALID_HANDLE_VALUE => -1;
use constant MAX_PATH => 260;

# Take a snapshot of all processes in the system.

my $hProcessSnap = $CreateToolhelp32Snapshot->Call(TH32CS_SNAPPROCESS, 0);
die "CreateToolhelp32Snapshot: $!($^E)" if $hProcessSnap ==
INVALID_HANDLE_VALUE;

# Struct PROCESSENTRY32:
# DWORD dwSize; # 0 for 4
# DWORD cntUsage; # 4 for 4
# DWORD th32ProcessID; # 8 for 4
# DWORD th32DefaultHeapID; # 12 for 4
# DWORD th32ModuleID; # 16 for 4
# DWORD cntThreads; # 20 for 4
# DWORD th32ParentProcessID; # 24 for 4
# LONG pcPriClassBase; # 28 for 4
# DWORD dwFlags; # 32 for 4
# char szExeFile[MAX_PATH]; # 36 for 260

# Set the size of the structure before using it.

my $dwSize = MAX_PATH + 36;
my $pe32 = pack 'I9C260', $dwSize, 0 x 8, '0' x MAX_PATH;
my $lppe32 = pack 'P', $pe32;

# Retrieve information about the first process, and exit if unsuccessful

my $ret = $Process32First->Call($hProcessSnap, $pe32);
do {
if (not $ret) {
$CloseHandle->Call($hProcessSnap);
warn "Process32First: ret=$ret, $!($^E)";
return undef;
}

# return ppid if pid == my pid

my $th32ProcessID = unpack 'I', substr $pe32, 8, 4;
return unpack ('I', substr $pe32, 24, 4) if $$ == $th32ProcessID;

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

$CloseHandle->Call($hProcessSnap);
return undef;

}

__END__


Detached script starter - I start like this from tcsh :

perl detach.pl 'f:/perl/bin/perl.exe' 'getppid.pl -o'
perl detach.pl 'f:/perl/bin/perl.exe' 'getppid.pl -a'

#!perl --

use strict;
use warnings;
use Win32::Process;

print qq{pid=$$, Win32::Process::Create(\$pObj, "$ARGV[0]", "@ARGV", 0, },
DETACHED_PROCESS, qq{, '.'\n};

my $pObj;
Win32::Process::Create($pObj, $ARGV[0], "@ARGV", 0, DETACHED_PROCESS, ".") or
die "Win32::Process::Create: $!($^E)";

my $cpid = $pObj->GetProcessID();
print "child pid=$cpid started - $$ exiting\n";

exit; # don't wait for child
_______________________________________________
ActivePerl mailing list
ActivePerl@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs