Thema Datum  Von Nutzer Rating
Antwort
03.02.2025 13:12:07 Gast98551
NotSolved
03.02.2025 19:04:25 Gast75772
NotSolved
03.02.2025 20:39:14 volti
NotSolved
04.02.2025 12:30:20 Gast19586
NotSolved
04.02.2025 14:08:15 Volti
NotSolved
Blau Systree - Absturz bei Zugriff auf Knoten (externes Programm)
04.02.2025 15:28:04 Gast67987
NotSolved
04.02.2025 15:58:49 Gast31143
NotSolved
04.02.2025 16:59:30 Gast39622
NotSolved
04.02.2025 18:12:20 volti
NotSolved
04.02.2025 18:25:46 volti
NotSolved
04.02.2025 19:13:41 volti
NotSolved
04.02.2025 22:38:12 Gast85035
NotSolved
04.02.2025 23:25:24 volti
NotSolved
05.02.2025 00:38:44 Gast32890
NotSolved
05.02.2025 08:42:33 volti
NotSolved
05.02.2025 08:56:36 volti
NotSolved
09.02.2025 21:57:35 Gast46537
NotSolved
05.02.2025 13:33:01 Gast89171
NotSolved
05.02.2025 15:04:45 Gast15904
NotSolved
09.02.2025 18:13:22 Gast6908
Solved

Ansicht des Beitrags:
Von:
Gast67987
Datum:
04.02.2025 15:28:04
Views:
51
Rating: Antwort:
  Ja
Thema:
Systree - Absturz bei Zugriff auf Knoten (externes Programm)

Danke Volti

Doch weiterhin bleibt das Problem bestehen, dass das Programm abstürzt:

' API-Deklarationen
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As LongPtr

Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
    ByVal hWndParent As LongPtr, _
    ByVal hWndChildAfter As LongPtr, _
    ByVal lpszClass As String, _
    ByVal lpszWindow As String) As LongPtr

Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    ByVal hWnd As LongPtr, _
    ByVal Msg As Long, _
    ByVal wParam As LongPtr, _
    ByRef lParam As Any) As LongPtr

Declare PtrSafe Function GetClassNameA Lib "user32" ( _
    ByVal hWnd As LongPtr, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long

Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef Destination As Any, _
    ByRef Source As Any, _
    ByVal Length As Long)

' Konstanten für TreeView-Operationen
Const TV_FIRST As Long = &H1100
Const TVM_GETNEXTITEM As Long = TV_FIRST + 10
Const TVM_GETITEM As Long = TV_FIRST + 12
Const TVGN_ROOT As Long = &H0
Const TVGN_NEXT As Long = &H1
Const TVIF_TEXT As Long = &H1

' TreeView-Item Struktur
Type TVITEM
    mask As Long
    hItem As LongPtr
    state As Long
    stateMask As Long
    pszText As LongPtr
    cchTextMax As Long
    iImage As Long
    iSelectedImage As Long
    cChildren As Long
    lParam As LongPtr
End Type

Sub EnumerateTreeView()
    Dim hWndParent As LongPtr
    Dim hWndTree As LongPtr
    Dim hItem As LongPtr
    Dim tvItem As TVITEM
    Dim buffer As String
    Dim result As LongPtr
    Dim row As Integer

    ' Fenster "Diff" suchen
    hWndParent = FindWindowHandleByTitle("Diff")
    If hWndParent = 0 Then
        MsgBox "Fenster mit Titel 'Diff' nicht gefunden!"
        Exit Sub
    End If

    ' Suche nach dem TreeView-Steuerelement im Fenster
    hWndTree = FindChildWindowHandleByClassName(hWndParent, "SysTreeView32")
    If hWndTree = 0 Then
        MsgBox "TreeView-Steuerelement nicht gefunden!"
        Exit Sub
    End If

    ' Root-Knoten abrufen
    hItem = SendMessage(hWndTree, TVM_GETNEXTITEM, TVGN_ROOT, ByVal 0&)
    If hItem = 0 Then
        MsgBox "Kein Root-Knoten gefunden."
        Exit Sub
    End If

    row = 1

    Do While hItem <> 0
        buffer = String(256, vbNullChar) ' Puffer initialisieren

        ' TVITEM initialisieren
        With tvItem
            .mask = TVIF_TEXT
            .hItem = hItem
            .pszText = StrPtr(buffer)
            .cchTextMax = Len(buffer)
        End With

        ' Knoteninformationen abrufen
        result = SendMessage(hWndTree, TVM_GETITEM, 0, tvItem) ' Hier stürzt das externe Programm ab.
        If result <> 0 Then
            ' Knoteninformationen in die Tabelle schreiben
            Cells(row, 5).Value = Left(buffer, InStr(buffer, vbNullChar) - 1)
            row = row + 1
        Else
            Debug.Print "Fehler beim Abrufen des Knotens: " & hItem
        End If

        ' Nächsten Knoten abrufen
        hItem = SendMessage(hWndTree, TVM_GETNEXTITEM, TVGN_NEXT, hItem)
    Loop

    MsgBox "Fertig! Knoten wurden ab Spalte E eingefügt."
End Sub

Function FindWindowHandleByTitle(windowTitle As String) As LongPtr
    ' Sucht nach einem Fenster mit einem bestimmten Titel und gibt das Handle zurück
    FindWindowHandleByTitle = FindWindow(vbNullString, windowTitle)
End Function

Function FindChildWindowHandleByClassName(hWndParent As LongPtr, className As String) As LongPtr
    Dim hWndChild As LongPtr
    hWndChild = FindWindowEx(hWndParent, 0, vbNullString, vbNullString)

    Do While hWndChild <> 0
        ' Prüfen, ob das aktuelle Fenster die gewünschte Klasse hat
        If GetWindowClassName(hWndChild) = className Then
            FindChildWindowHandleByClassName = hWndChild
            Exit Function
        End If

        ' Rekursiv nach weiteren Kindern suchen
        FindChildWindowHandleByClassName = FindChildWindowHandleByClassName(hWndChild, className)
        If FindChildWindowHandleByClassName <> 0 Then Exit Function

        ' Nächstes Kind suchen
        hWndChild = FindWindowEx(hWndParent, hWndChild, vbNullString, vbNullString)
    Loop

    ' Kein passendes Fenster gefunden
    FindChildWindowHandleByClassName = 0
End Function

Function GetWindowClassName(hWnd As LongPtr) As String
    Dim classNameBuffer As String
    classNameBuffer = String(256, vbNullChar)
    Dim result As Long
    result = GetClassNameA(hWnd, classNameBuffer, Len(classNameBuffer))
    If result <> 0 Then
        GetWindowClassName = Left(classNameBuffer, result)
    Else
        GetWindowClassName = vbNullString
    End If
End Function

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
03.02.2025 13:12:07 Gast98551
NotSolved
03.02.2025 19:04:25 Gast75772
NotSolved
03.02.2025 20:39:14 volti
NotSolved
04.02.2025 12:30:20 Gast19586
NotSolved
04.02.2025 14:08:15 Volti
NotSolved
Blau Systree - Absturz bei Zugriff auf Knoten (externes Programm)
04.02.2025 15:28:04 Gast67987
NotSolved
04.02.2025 15:58:49 Gast31143
NotSolved
04.02.2025 16:59:30 Gast39622
NotSolved
04.02.2025 18:12:20 volti
NotSolved
04.02.2025 18:25:46 volti
NotSolved
04.02.2025 19:13:41 volti
NotSolved
04.02.2025 22:38:12 Gast85035
NotSolved
04.02.2025 23:25:24 volti
NotSolved
05.02.2025 00:38:44 Gast32890
NotSolved
05.02.2025 08:42:33 volti
NotSolved
05.02.2025 08:56:36 volti
NotSolved
09.02.2025 21:57:35 Gast46537
NotSolved
05.02.2025 13:33:01 Gast89171
NotSolved
05.02.2025 15:04:45 Gast15904
NotSolved
09.02.2025 18:13:22 Gast6908
Solved