AW: VBA: 'fremde' Fensterhandles finden ?
20.12.2008 23:00:15
Tino
Hallo,
so jetzt müssten die nötigen Infos dabei sein.
Modul Modul1
Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () _
As Long
Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" (ByVal hwnd As Long) _
As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal wIndx As _
Long) As Long
Private Declare Function GetParent Lib "user32" (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
Const GW_HWNDFIRST = 0
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Const GW_HWNDPREV = 3
Const GW_OWNER = 4
Const GW_CHILD = 5
Const GW_MAX = 5
Const GWL_STYLE = (-16)
Const WS_VISIBLE = &H10000000
Const WS_BORDER = &H800000
Private Sub GetWindowInfo(ByVal hwnd&, bVisible As Boolean, booMit_Titel As Boolean)
Dim Parent&, Task&, Result&, X&, Style&, Title$
Dim nRetVal&, strClassName$
Dim mCaption
Dim A As Long
'Darstellung des Fensters
Style = GetWindowLong(hwnd, GWL_STYLE)
Style = Style And (WS_VISIBLE Or WS_BORDER)
Result = GetWindowTextLength(hwnd) + 1
Title = Space$(Result)
Result = GetWindowText(hwnd, Title, Result)
Title = Left$(Title, Len(Title) - 1)
If (Style = (WS_VISIBLE Or WS_BORDER)) Or bVisible = False Then
If Title <> "" Or booMit_Titel = False Then
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = CStr(hwnd)
Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) = Title
'Elternfenster ermitteln
Parent = hwnd
Do
Parent = GetParent(Parent)
Loop Until Parent = 0
'Task Id ermitteln
Result = GetWindowThreadProcessId(hwnd, Task)
Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = Task
strClassName = Space$(64)
nRetVal = GetClassName(hwnd, strClassName, Len(strClassName))
strClassName = Left$(strClassName, nRetVal)
Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = strClassName
End If
End If
End Sub
Private Sub Read_App()
Dim objWMIService As Object, cProcesses As Object, fProcess As Object
Dim Bereich As Range, A As Long
Dim myArea, myArea2()
Set Bereich = Range("C2", Cells(Rows.Count, 3).End(xlUp))
myArea = Bereich
Set Bereich = Bereich.Offset(0, 2)
myArea2 = Bereich
Set objWMIService = GetObject("winmgmts:")
Set cProcesses = objWMIService.ExecQuery("Select * from Win32_Process")
For Each fProcess In cProcesses
With fProcess
For A = 1 To Ubound(myArea)
If myArea(A, 1) = .ProcessId Then
myArea2(A, 1) = .Name
End If
Next A
End With
Next
Bereich = myArea2
End Sub
Sub vList_Prozesse()
Dim hwnd As Long, tbuf As String, RetVal As Long
'Einstellung nur Sichtbare und mit Fenstertitel
'True ist ja, False nein
Const Nur_Sichtbare As Boolean = False
Const Nur_mit_Fenstertitel As Boolean = False
'Zellen leeren und Überschrift
Cells.Clear
Range("A1") = "hwnd"
Range("B1") = "Titel"
Range("C1") = "Prozess ID"
Range("D1") = "Class Name"
Range("E1") = "Applikation"
Range("A1:E1").Font.Bold = True
'______________________________
'hwnd Deskdopt
hwnd = GetDesktopWindow()
hwnd = GetWindow(hwnd, GW_CHILD)
'hwnd, nur Sichtbar, nur Mit Fenstertitel
GetWindowInfo hwnd, Nur_Sichtbare, Nur_mit_Fenstertitel
Do While hwnd <> 0
tbuf = String(255, 0)
RetVal = GetWindowText(hwnd, tbuf, Len(tbuf))
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
'hwnd, nur Sichtbar, nur mit Fenstertitel
GetWindowInfo hwnd, Nur_Sichtbare, Nur_mit_Fenstertitel
Loop
Call Read_App
Columns("A:E").EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 35
End Sub
Gruß Tino