Tipp-Upload: VB 5/6 0446: Verbesserug von Tipp 756: Inhalt fremder Messageboxen auslesen

Über den Tipp  

Dieser Vorschlag soll VB 5/6 Tipp 756 ersetzen.

Dieser Tippvorschlag wird übernommen.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Fenster

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Mssagebox, API

Der Vorschlag wurde erstellt am: 11.03.2015 09:10.
Die letzte Aktualisierung erfolgte am 11.03.2015 09:10.

Zurück zur Übersicht

Beschreibung  

Der Code findet alle MessageBoxen mit einem bestimmten Titel.
Im Gegensatz zu Tipp 756 ist der zu suchender Titel frei wählbar. Des weiteren werden alle MessageBoxen mit dem Titel gefunden.

Schwierigkeitsgrad

Verwendete API-Aufrufe: FindWindowA, FindWindowExA (FindWindowEx), GetClassNameA (GetClassName&), GetWindow, SendMessageA (SendMessageByNum&), SendMessageA (SendMessageByString)

Download: Download des Beispielprojektes [1,95 KB]

' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' ----------- Anfang Projektdatei Find_MsgBox.vbp  -----------

' ------- Anfang Formular "frmMain" alias frmMain.frm  -------

' Steuerelement: Rahmensteuerelement "frameTxt"
' Steuerelement: Rahmensteuerelement "frameErgebnis"
' Steuerelement: Kontrollkästchen-Steuerelement "chk" auf frameTxt
' Steuerelement: Textfeld "txt" auf frameTxt
' Steuerelement: Listen-Steuerelement "lb" auf frameErgebnis

Option Explicit

Private Declare Function FindWindowA Lib "user32" ( _
                         ByVal lpClassName As String, _
                         ByVal lpWindowName As String) As Long

Private Declare Function GetClassName& Lib "user32" _
                         Alias "GetClassNameA" ( _
                         ByVal Hwnd As Long, _
                         ByVal lpClassName As String, _
                         ByVal nMaxCount As Long)

Private Declare Function SendMessageByNum& Lib "user32" _
                         Alias "SendMessageA" ( _
                         ByVal Hwnd As Long, _
                         ByVal wMsg As Long, _
                         ByVal wParam As Long, _
                         ByVal lParam As Long)

Private Declare Function SendMessageByString Lib "user32" _
                         Alias "SendMessageA" ( _
                         ByVal Hwnd As Long, _
                         ByVal wMsg As Long, _
                         ByVal wParam As Long, _
                         ByVal lParam As String) As Long

Private Declare Function FindWindowEx Lib "user32" _
                         Alias "FindWindowExA" ( _
                         ByVal hWnd1 As Long, _
                         ByVal hWnd2 As Long, _
                         ByVal lpsz1 As String, _
                         ByVal lpsz2 As String) As Long

Private Declare Function GetWindow Lib "user32" ( _
                         ByVal Hwnd As Long, _
                         ByVal wCmd As Long) As Long

Const WM_GETTEXTLENGTH = &HE
Const WM_GETTEXT = &HD
Const GW_HWNDNEXT = 2

Private Sub chk_Click()

    Call txt_Change

End Sub

Private Sub txt_Change()

    lb.Clear

    Call FindMessageBoxen

End Sub

Private Sub FindMessageBoxen()

    Dim Hwnd As Long

    Hwnd = FindWindowA(vbNullString, txt.Text)

    If Hwnd <> 0 Then

        Call CheckHwnd(Hwnd)

        Do While Hwnd <> 0
            Hwnd = GetWindow(Hwnd, GW_HWNDNEXT)

            Call CheckHwnd(Hwnd)

        Loop

    End If

    frameErgebnis.Caption = "Ergebnis (" & lb.ListCount & " MessageBoxen)"

End Sub

Private Sub CheckHwnd(ByVal Hwnd As Long)

    Dim MsgHwnd As Long
    Dim Msg As String

    If Get_Class(Hwnd) <> "#32770" Then

        Exit Sub

    Else

        If IIf(chk.Value, Get_Text(Hwnd), LCase$(Get_Text(Hwnd))) <> IIf(chk.Value, txt.Text, _
            LCase$(txt.Text)) Then

            Exit Sub

        Else

            If FindWindowEx(Hwnd, 0, "Button", vbNullString) = 0 Then

                Exit Sub

            Else
                MsgHwnd = FindWindowEx(Hwnd, 0, "Static", vbNullString)

                If MsgHwnd = 0 Then

                    Exit Sub

                Else
                    Msg = Get_Text(MsgHwnd)

                    lb.AddItem Msg
                End If
            End If
        End If
    End If

End Sub

Private Function Get_Class(ByVal Hwnd As Long) As String

    Dim Buffer As String
    Dim GetClas As Long

    Buffer = Space(250)
    GetClas = GetClassName(Hwnd, Buffer, 250)
    Get_Class = Left$(Buffer, GetClas)

End Function

Public Function Get_Text(ByVal Hwnd As Long) As String

    Dim GetTrim As Long
    Dim TrimSpace As String, GetString As String

    GetTrim = SendMessageByNum(Hwnd, WM_GETTEXTLENGTH, 0&, 0&)
    TrimSpace = Space$(GetTrim)
    GetString = SendMessageByString(Hwnd, WM_GETTEXT, GetTrim + 1, TrimSpace)

    Get_Text = TrimSpace

End Function

' -------- Ende Formular "frmMain" alias frmMain.frm  --------

' ------------ Ende Projektdatei Find_MsgBox.vbp  ------------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.