Tuesday 1 October 2013

How to search windows component using Windows API in Visual Basic 6.0

Download Source Code

Option Explicit
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) 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 ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetMenuItemCount Lib "user32" _
(ByVal hMenu As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" _
Alias "GetMenuItemInfoA" (ByVal hMenu As Long, _
ByVal un As Long, ByVal b As Boolean, _
lpMenuItemInfo As MENUITEMINFO) As Boolean

Const MF_BYPOSITION = &H400&
Const MF_REMOVE = &H1000&

Private Const MIIM_ID = &H2
Private Const MIIM_TYPE = &H10
Private Const MFT_STRING = &H0&

Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type

Dim taskBarhWnd As Long, notifyTrayhWnd As Long, rebarWindow As Long, toolbarWindow As Long, quickLaunchWindow As Long, startBtnWindow As Long
Dim ppthWnd As Long, ribbonhWnd As Long, panehWnd As Long, deskhWnd As Long, vbhWnd As Long, vbmainMenuhWnd As Long, vbaWindowhWnd As Long, ExplorerhWnd As Long

Private Sub Command1_Click(Index As Integer)
    Select Case Index
    Case 0
        taskBarhWnd = FindWindow("Shell_TrayWnd", vbNullString)
        notifyTrayhWnd = FindWindowEx(taskBarhWnd, 0&, "TrayNotifyWnd", vbNullString)
        Call ShowWindow(notifyTrayhWnd, show_Chk(Index).Value)
    Case 1
        taskBarhWnd = FindWindow("Shell_TrayWnd", vbNullString)
        'toolbarWindow = FindWindow("RebarWindow32", "")
        rebarWindow = FindWindowEx(taskBarhWnd, 0&, "RebarWindow32", "")
        Call ShowWindow(rebarWindow, show_Chk(Index).Value)
    Case 2
        taskBarhWnd = FindWindow("Shell_TrayWnd", vbNullString)
        'toolbarWindow = FindWindow("RebarWindow32", "")
        quickLaunchWindow = FindWindowEx(FindWindowEx(taskBarhWnd, 0&, "RebarWindow32", ""), 0&, "ToolbarWindow32", "Quick Launch")
        Call ShowWindow(quickLaunchWindow, show_Chk(Index).Value)
    Case 3
        taskBarhWnd = FindWindow("Shell_TrayWnd", vbNullString)
        startBtnWindow = FindWindowEx(taskBarhWnd, 0&, "button", "start")
        Call ShowWindow(startBtnWindow, show_Chk(Index).Value)
    Case 4
        taskBarhWnd = FindWindow("Shell_TrayWnd", vbNullString)
        'toolbarWindow = FindWindow("RebarWindow32", "")
        quickLaunchWindow = FindWindowEx(FindWindowEx(taskBarhWnd, 0&, "RebarWindow32", ""), 0&, "ToolbarWindow32", "Quick Launch")
        toolbarWindow = FindWindowEx(FindWindowEx(taskBarhWnd, 0&, "RebarWindow32", ""), quickLaunchWindow, "ToolbarWindow32", "Running Applications")
        Call ShowWindow(toolbarWindow, show_Chk(Index).Value)
    Case 5
        ppthWnd = FindWindow("PP12FrameClass", vbNullString)
        'panehWnd = FindWindowEx(ppthWnd, 0&, "paneClassDC", "Slide")
        Call ShowWindow(ppthWnd, show_Chk(Index).Value)
    Case 6
        ppthWnd = FindWindow("PP11FrameClass", vbNullString)
        'panehWnd = FindWindowEx(ppthWnd, 0&, "paneClassDC", "Slide")
        Call ShowWindow(ppthWnd, show_Chk(Index).Value)
    Case 7
        vbhWnd = FindWindow("wndclass_desked_gsk", vbNullString)
        'panehWnd = FindWindowEx(ppthWnd, 0&, "paneClassDC", "Slide")
        Call ShowWindow(vbhWnd, show_Chk(Index).Value)
    Case 8
        vbhWnd = FindWindow("wndclass_desked_gsk", vbNullString)
        vbmainMenuhWnd = FindWindowEx(FindWindowEx(vbhWnd, 0&, "MsoCommandBarDock", "MsoDockTop"), 0&, "MsoCommandBar", "Menu Bar")
        'panehWnd = FindWindowEx(ppthWnd, 0&, "paneClassDC", "Slide")
        Call ShowWindow(vbmainMenuhWnd, show_Chk(Index).Value)
    Case 9
        vbhWnd = FindWindow("wndclass_desked_gsk", vbNullString)
        vbaWindowhWnd = FindWindowEx(FindWindowEx(vbhWnd, 0&, "MDIClient", ""), 0&, "VbaWindow", "Form1 (Code)")
        'panehWnd = FindWindowEx(ppthWnd, 0&, "paneClassDC", "Slide")
        Call ShowWindow(vbaWindowhWnd, show_Chk(Index).Value)
    Case 10
        ExplorerhWnd = FindWindow("CabinetWClass", "My Computer")
       ' vbaWindowhWnd = FindWindowEx(FindWindowEx(vbhWnd, 0&, "MDIClient", ""), 0&, "#32770(Dialog)", "Display Properties")
        'panehWnd = FindWindowEx(ppthWnd, 0&, "paneClassDC", "Slide")
        Call ShowWindow(FindWindow("CabinetWClass", "My Computer"), show_Chk(Index).Value)
        Call ShowWindow(FindWindow("ExploreWClass", "My Computer"), show_Chk(Index).Value)
    End Select
End Sub

Private Sub Text1_LostFocus()
    Timer1.Enabled = False
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        Timer1.Enabled = True
        Timer1.Interval = 10
    End If
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
    Dim hMenu As Long, hSubMenu As Long, hID As Long, ExtraSubMenu As Long
'    'hMenu = GetActiveWindow
    hMenu = GetMenu(Me.hwnd)
'
    If GetMenuItemCount(hMenu) > 0 Then
        RemoveMenu hMenu, 0, MF_BYPOSITION Or MF_REMOVE
        RemoveMenu hMenu, 1, MF_BYPOSITION Or MF_REMOVE
    End If
'    Debug.Print hMenu
    hSubMenu = GetSubMenu(hMenu, 0)
   
    Debug.Print hSubMenu
    Call ShowWindow(hSubMenu, 0)
End Sub

No comments: