Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const TH32CS_SNAPPROCESS = &H2
Private Const INVALID_HANDLE = &HFFFFFFFF
Private Const MAX_PATH As Long = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
(ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" _
(ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" _
(ByVal hSnapshot As Long, _
uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" _
(ByVal hPass As Long)
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Sub Form_Load()
Command1.Caption = "Get Parent Process"
End Sub
Private Sub Command1_Click()
Text1.Text = GetParentProcess2()
End Sub
Private Function GetParentProcess2() As String
Dim hSnapshot As Long
Dim pe As PROCESSENTRY32
'create a snapshot of the system
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If hSnapshot <> INVALID_HANDLE Then
'call FindProcess passing the
'snapshot handle and the result
'of a GetCurrentProcessID API call
'to obtain the process entry data
'for the current app.
pe = FindProcess(hSnapshot, GetCurrentProcessId())
'if a match is found, the value of
'interest is the parent process ID.
'This gets passed to a second call to
'FindProcess.
If pe.th32ParentProcessID <> 0 Then
pe = FindProcess(hSnapshot, pe.th32ParentProcessID)
'if a parent proccess match was found,
'the szExeFile parmeter of the returned
'data holds the parent application name
If pe.th32ProcessID <> 0 Then
GetParentProcess2 = TrimNull(pe.szExeFile)
Else
GetParentProcess2 = "[no match; parent must have closed]"
End If
End If
CloseHandle hSnapshot
End If
End Function
Private Function FindProcess(ByVal hSnapshot As Long, _
ByVal dwProcID As Long) As PROCESSENTRY32
Dim pe As PROCESSENTRY32
'initialize the type
pe.dwSize = Len(pe)
'double check the snapshot handle
If hSnapshot <> INVALID_HANDLE Then
Call Process32First(hSnapshot, pe)
'loop until a process matching
'dwProcID is found, or until
'nothing more to enumerate
Do
If pe.th32ProcessID = dwProcID Then
'match found; return the
'data as a PROCESSENTRY32 type
FindProcess = pe
Exit Do
End If
Loop Until Process32Next(hSnapshot, pe) = 0
End If
End Function
Private Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function |
When
the project above is run in the IDE, the parent process returned is
explorer.exe.
To test this for the demo I complied the code above as project1.exe. I
then created a second project with one line of code: Call Shell("d:\project1.exe",
vbNormalFocus).
When this calling application was run in the IDE to launch project1.exe,
the parent app returned was VB6.exe. When the calling program was
compiled into go.exe and run, the parent program was correctly returned
as go.exe. If project1.exe is opened via explorer, the parent is
explorer.exe. Apps with explorer.exe as parent can be assumed to have
been started via explorer or an explorer shortcut. |