VB 灰色按钮客星

无聊时写的程序。没什么技术可言，就是使用了鼠标钩子和一些遍历子窗体的函数等等，有兴趣的可以看看，下面是源码。

主窗体源码：

Option Explicit
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
'显示XP风格函数
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()

Private Sub Form_Initialize()
    '显示XP风格
    InitCommonControls
End Sub

Private Sub cmdEnabled_Click()
    If Me.lstEnableButton.ListCount = 0 Then
        MessageBox Me.hwnd, "目前还没有选项!!", "提示", 0
    End If
    Dim strList As String, lnghWnd As Long
    strList = Me.lstEnableButton.List(Me.lstEnableButton.ListIndex)
    strList = Mid(strList, InStr(strList, "句柄为:") + Len("句柄为:") + 1, Len(strList) - InStr(strList, "句柄为:") - Len("句柄为:"))
    If IsNumeric(strList) Then
        lnghWnd = CLng(strList)
    Else
        lnghWnd = 0
    End If
    Call EnableWindow(lnghWnd, 0)
    MessageBox Me.hwnd, "设置成功!!", "提示", 0
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdRestore_Click()
    Dim strList As String, lnghWnd As Long
    If Me.lstEnableButton.ListCount = 0 Then
        MessageBox Me.hwnd, "目前还没有选项!!", "提示", 0
    End If
    strList = Me.lstEnableButton.List(Me.lstEnableButton.ListIndex)
    strList = Mid(strList, InStr(strList, "句柄为:") + Len("句柄为:") + 1, Len(strList) - InStr(strList, "句柄为:") - Len("句柄为:"))
    If IsNumeric(strList) Then
        lnghWnd = CLng(strList)
    Else
        lnghWnd = 0
    End If
    Call EnableWindow(lnghWnd, 1)
    MessageBox Me.hwnd, "设置成功!!", "提示", 0
End Sub

Private Sub cmdStop_Click()
    If cmdStop.Caption = "停止扫描" Then
        UnhookWindowsHookEx hHook
        cmdStop.Caption = "开始扫描"
    Else
        cmdStop.Caption = "停止扫描"
        hHook = SetWindowsHookEx(WH_MOUSE_DLL, AddressOf MouseProc, App.hInstance, 0)
    End If
End Sub

Private Sub Form_Load()
    hHook = SetWindowsHookEx(WH_MOUSE_DLL, AddressOf MouseProc, App.hInstance, 0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnhookWindowsHookEx hHook
End Sub


模块源码：
Option Explicit

Public Const WH_MOUSE = 7
Public Const WH_MOUSE_DLL = 14
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint 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 IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam 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
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_FINDSTRING = &H18F

Private Type POINTAPI
        X As Long
        Y As Long
End Type
Private Type MOUSEHOOKSTRUCT
        pt As POINTAPI
        hwnd As Long
        wHitTestCode As Long
        dwExtraInfo As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public hHook As Long
Private objMOUSEMSG As MOUSEHOOKSTRUCT

Public Function MouseProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim p As POINTAPI, strClassName As String * 260, lnghWnd As Long, lngRet As Long
    If idHook < 0 Then
        'call the next hook
        MouseProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    Else
        CopyMemory objMOUSEMSG, ByVal lParam, LenB(objMOUSEMSG)
        'GetCursorPos p
        'lnghWnd = WindowFromPoint(p.X, p.Y)
        lnghWnd = WindowFromPoint(objMOUSEMSG.pt.X, objMOUSEMSG.pt.Y)
        If lnghWnd > 0 And lnghWnd <> frmMain.hwnd Then EnumChildWindows lnghWnd, AddressOf ChlidWindowProc, 0
        'lngRet = GetClassName(lnghWnd, strClassName, 260)
'        If LCase(Left(strClassName, lngRet)) = "button" Or Left(strClassName, lngRet) = "ThunderCommandButton" Then
'            If IsWindowEnabled(lnghWnd) Then
'                'EnableWindow lnghWnd, 0
'                ShowWindow lnghWnd, 0
'            Else
'                'EnableWindow lnghWnd, 1
'                ShowWindow lnghWnd, 5
'            End If
'        End If
'        Debug.Print "鼠标下的句柄是:" & lnghWnd & "  类名是:" & Left(strClassName, lngRet)
        'call the next hook
        MouseProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
    End If
End Function

Public Function ChlidWindowProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
    Dim lngRet As Long, strClassName As String * 260, strMessage As String, lngFind As Long
    lngRet = GetClassName(hwnd, strClassName, 260)
    If InStr(LCase(Left(strClassName, lngRet)), "button") > 0 Then
        If 0 = IsWindowEnabled(hwnd) Then
            strMessage = "在窗体名为: " & GetWindowCaption(GetParenthWnd(hwnd)) & " 被禁用的按钮名为: " & GetWindowCaption(hwnd) & " 句柄为: " & hwnd
            lngFind = SendMessage(frmMain.lstEnableButton.hwnd, LB_FINDSTRING, -1, ByVal strMessage)
            If lngFind = -1 Then frmMain.lstEnableButton.AddItem strMessage
            'Debug.Print "在窗体: " & GetWindowCaption(GetParenthWnd(hWnd)) & " 被禁用的按钮: " & GetWindowCaption(hWnd) & " 句柄为: " & hWnd
            'EnableWindow hWnd, 1
        End If
    End If
    ChlidWindowProc = True
End Function

Public Function GetParenthWnd(ByVal hwnd As Long) As Long
    Dim lngPrehWnd As Long, lnghWnd As Long
    lnghWnd = GetParent(hwnd)

    If lnghWnd > 0 Then
        Do While 1
            DoEvents
            lngPrehWnd = lnghWnd
            lnghWnd = GetParent(lnghWnd)
            If lnghWnd = 0 Then
                GetParenthWnd = lngPrehWnd
                Exit Function
            End If
        Loop
    Else
        GetParenthWnd = hwnd
    End If
End Function

Public Function GetWindowCaption(ByVal hwnd As Long) As String
    Dim lngLen As String, strTmp As String * 260, lngRet As Long
    lngLen = GetWindowTextLength(hwnd)
    If lngLen = 0 Then
        GetWindowCaption = ""
    Else
        lngRet = GetWindowText(hwnd, strTmp, lngLen + 1)
        GetWindowCaption = Replace(Trim(Left(strTmp, lngRet)), Chr(0), "")
    End If
End Function