Private Declare Function GetWindow Lib "user32" (ByVal hwnd as
Long, ByVal wCmd as
Long) as
Long
Private Declare Function GetWindowTextLength Lib "user32" alias
"GetWindowTextLengthA" (ByVal hwnd as
Long) as
Long
Private Declare Function GetWindowText Lib "user32" alias
"GetWindowTextA" (ByVal hwnd as
Long, ByVal lpString as
String, ByVal cch as
Long) as
Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd as
Long, lpdwProcessId as
Long) as
Long
Const GW_CHILD = 5
Const GW_HWNDFIRST = 0
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Const GW_HWNDPREV = 3
Const GW_MAX = 5
Const GW_OWNER = 4
Sub GetRunningApplications()
dim
lLgthChild as
Long
dim
sNameChild as
String
dim
lLgthOwner as
Long
dim
sNameOwner as
String
dim
lHwnd as
Long
dim
lHwnd2 as
Long
dim
lProssId as
Long
Const vbTextCompare = 1
lHwnd = GetWindow(Me.hwnd, GW_HWNDFIRST)
While lHwnd <> 0
lHwnd2 = GetWindow(lHwnd, GW_OWNER)
lLgthOwner = GetWindowTextLength(lHwnd2)
sNameOwner = String$(lLgthOwner + 1, Chr$(0))
lLgthOwner = GetWindowText(lHwnd2, sNameOwner, lLgthOwner + 1)
If lLgthOwner <> 0 Then
sNameOwner = Left$(sNameOwner, InStr(1, sNameOwner, Chr$(0), vbTextCompare) - 1)
Call GetWindowThreadProcessId(lHwnd2, lProssId)
Debug.Print sNameOwner, lProssId
end
If
lLgthChild = GetWindowTextLength(lHwnd)
sNameChild = String$(lLgthChild + 1, Chr$(0))
lLgthChild = GetWindowText(lHwnd, sNameChild, lLgthChild + 1)
If lLgthChild <> 0 Then
sNameChild = Left$(sNameChild, InStr(1, sNameChild, Chr$(0), vbTextCompare) - 1)
Call GetWindowThreadProcessId(lHwnd, lProssId)
Debug.Print sNameChild, lProssId
end
If
lHwnd = GetWindow(lHwnd, GW_HWNDNEXT)
DoEvents
Wend
End Sub
Return