VB 灰色按钮客星

原创 2007年10月03日 12:26:00

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

主窗体源码:

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 

突破灰色按钮原理讲解

笔者在使用各种收费软件的时候总想去找破解版,在找不到破解版的情况下,又尝试各种破解办法,去突破收费功能,相信大家跟我一样,也经常这么做。不过这样做真心使我们的软件行业一路沉沦下去,没人再愿意去努力做更...
  • jingyukxy
  • jingyukxy
  • 2014年08月02日 17:15
  • 1445

Button设置可用或灰色不可用

CButton *pBtn = (CButton *)GetDlgItem(ID) ; pBtn->EnableWindow( FALSE ) ;//不可用 pBtn->EnableWindow...
  • Arcsinsin
  • Arcsinsin
  • 2013年08月01日 20:44
  • 1225

JAVASCRIPT之灰色按钮

JAVASCRIPT之灰色按钮
  • netuser1937
  • netuser1937
  • 2017年02月06日 15:31
  • 251

电脑休眠按钮灰色的解决方法

这篇文章要是帮助一些朋友解决win7无法进入睡眠状态的问题,请看好是睡眠而不是休眠,关于什么是休眠和睡眠以及他们的区别,我就不赘述了,可以去百度谷歌一下,或者本论坛里也有很多相关的帖子可供查阅。   ...
  • haozi_1989
  • haozi_1989
  • 2011年05月27日 00:20
  • 2512

plsql developer 导出表按钮灰色

原因是我安装了2个oracle 客户端,在Perferences oci library改了客户端后,这里导出表界面就不能自动识别exp.exe了。 点export executable的文件夹图标...
  • huludownload
  • huludownload
  • 2014年03月07日 09:53
  • 6857

iTunes恢复备份时“恢复备份”按钮为灰色

iTunes恢复备份时“恢复备份”按钮为灰色,即使之前已经有备份在此台电脑上。 此时再备份一次,之前的就会出现在待选列表中了。目前还不知道为什么会出现这种现象….....
  • CapMiachael
  • CapMiachael
  • 2017年09月22日 12:01
  • 982

eclipse debug界面停止按钮灰色

进入debug后,停止debug的红色按钮为灰色,原因是未配置debug。 解决办法:点击小虫子右侧的下拉菜单,选择Debug Configurations...在弹出的窗口中,选择Target,如...
  • phenixyf
  • phenixyf
  • 2016年08月03日 10:24
  • 4251

软件灰色按钮 隐藏按钮破解

delphi   用dede 查看  看到有 visiable=false   软件拖入 peExplorer 进去修改 隐藏部分 灰色按钮  ShowWindow  SetWindowLong  ...
  • zcc1414
  • zcc1414
  • 2013年08月07日 18:12
  • 814

点击按钮变成灰色不可再次点击

原文转载自http://www.santii.com/article/24.html 很多时候,当我们点击提交按钮,如果因为执行的程序太慢,或是网络问题,就会一直处于提交状态。 不了解的人,...
  • cg20
  • cg20
  • 2017年11月07日 10:41
  • 233

AndroidStudio 运行按钮是灰色的

由于编者水平有限,文中难免会有错误和疏漏,请各位读者能提出宝贵建议或给予指正,可在博文下评论指出,我会及时改进,在此先感谢各位。   本文是自己学习所做笔记,欢迎转载,但请注明出处:http:/...
  • YiJuanXia
  • YiJuanXia
  • 2017年03月12日 10:38
  • 686
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB 灰色按钮客星
举报原因:
原因补充:

(最多只允许输入30个字)