| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 731 人关注过本帖, 1 人收藏
标题:钩子屏蔽 ExcelVBE编辑器
只看楼主 加入收藏
sdhtli
Rank: 1
等 级:新手上路
帖 子:115
专家分:0
注 册:2008-10-6
结帖率:72.22%
收藏(1)
已结贴  问题点数:20 回复次数:5 
钩子屏蔽 ExcelVBE编辑器
我在vb6中借用用了一段沟人的代码用来屏蔽 Excel VBE编辑器,运行老出错,请各位老师看看谢谢,VBE编辑器类名wndclass_desked_gsk,我把下面的代码生成DLL在Excel中调用出错呢

Public Declare Function GetActiveWindow Lib "user32" () As Long
'//取得类名
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'//设置钩子函数
Public 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
'//结束钩子
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
'//下一个钩子
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
'//取得当前线程的ID
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const HCBT_ACTIVATE = 5
Public Const HCBT_DESTROYWND = 4
Public Const HCBT_CREATEWND = 3
Public Const WM_CLOSE = &H10
Public Const HCBT_SETFOCUS = 9
Public Const WH_CBT = 5
Public IHook As Long
Public IThreadId As Long
Public ClassName As String
Public xlapp As Object
'-------设置钩子-----------
Public Sub EnableHook()
Set xlapp = GetObject(, "Excel.Application")
    If IHook = 0 Then
        IThreadId = GetCurrentThreadId '//取得当前线程的ID
        IHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, xlapp.hInstance, IThreadId)
    End If
End Sub
'-------取消钩子-----------
Public Sub FreeHook()
    If IHook <> 0 Then
        Call UnhookWindowsHookEx(IHook)
        IHook = 0
    End If
End Sub
'---------回调----------------
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case nCode
    Case HCBT_CREATEWND
    Case HCBT_DESTROYWND
    Case HCBT_ACTIVATE
        Dim WinText As String
        Dim ClsName As String
        '获取窗口标题及类名
        WinText = GetWindowTextString(wParam)
        ClsName = GetGetClassNameString(wParam)
        Debug.Print ClsName, GetWindowTextString(wParam)
        'VBE编辑器类名wndclass_desked_gsk
        If ClsName = "wndclass_desked_gsk" Then
            '发送关闭消息
            PostMessage wParam, WM_CLOSE, 0, 0
        End If
    End Select
    HookProc = CallNextHookEx(IHook, nCode, wParam, lParam)
End Function
Private Function GetWindowTextString(ByVal lhWnd As Long)
    Dim i As Long
    Dim Cap As String
    Dim CapB() As Byte
    Cap = Space$(256)
    i = GetWindowText(lhWnd, Cap, 256)
    CapB() = StrConv(Cap, vbFromUnicode)
    ReDim Preserve CapB(i - 1)
    GetWindowTextString = StrConv(CapB(), vbUnicode)
End Function
Private Function GetGetClassNameString(ByVal lhWnd As Long)
    Dim i As Long
    Dim Cap As String
    Dim CapB() As Byte
    Cap = Space$(256)
    i = GetClassName(lhWnd, Cap, 256)
    CapB() = StrConv(Cap, vbFromUnicode)
    ReDim Preserve CapB(i - 1)
    GetGetClassNameString = StrConv(CapB(), vbUnicode)
End Function

搜索更多相关主题的帖子: 编辑器 
2011-07-27 15:52
lisypro
Rank: 4
等 级:业余侠客
威 望:3
帖 子:695
专家分:216
注 册:2005-9-25
收藏
得分:10 
楼上是高手呀

长期承接管理系统
代做各种vb/ / vc小程序
QQ:82341763
手机:13623290828
群号 11619730
2011-07-27 19:14
sdhtli
Rank: 1
等 级:新手上路
帖 子:115
专家分:0
注 册:2008-10-6
收藏
得分:0 
什么云因呢
2011-07-28 11:11
bczgvip
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:66
帖 子:1310
专家分:5312
注 册:2009-2-26
收藏
得分:10 
程序代码:
Option Explicit

Public Declare Function GetActiveWindow Lib "user32" () As Long
'//取得类名
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'//设置钩子函数
Public 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
'//结束钩子
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
'//下一个钩子
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
'//取得当前线程的ID
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const HCBT_ACTIVATE = 5
Public Const HCBT_DESTROYWND = 4
Public Const HCBT_CREATEWND = 3
Public Const WM_CLOSE = &H10
Public Const HCBT_SETFOCUS = 9
Public Const WH_CBT = 5
Public IHook As Long
Public IThreadId As Long
Public ClassName As String
Public xlapp As Object

'-------设置钩子-----------
Public Sub EnableHook()
On Local Error GoTo Errs
Set xlapp = GetObject(, "Excel.Application")
    If IHook = 0 Then
        IThreadId = GetCurrentThreadId '//取得当前线程的ID
        IHook = SetWindowsHookEx(WH_CBT, AddressOf HookProc, xlapp.hInstance, IThreadId)
    End If
    Exit Sub
Errs:
    If 429 = Err.Number Then
        MsgBox "没找到已经打开的Excel", , Err.Number
    Else
        MsgBox Err.Description, , Err.Number
    End If
End Sub
'-------取消钩子-----------
Public Sub FreeHook()
    If IHook <> 0 Then
        Call UnhookWindowsHookEx(IHook)
        IHook = 0
    End If
End Sub
'---------回调----------------
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case nCode
    Case HCBT_CREATEWND
    Case HCBT_DESTROYWND
    Case HCBT_ACTIVATE
        Dim WinText As String
        Dim ClsName As String
        '获取窗口标题及类名
        WinText = GetWindowTextString(wParam)
        ClsName = GetGetClassNameString(wParam)
        Debug.Print ClsName, GetWindowTextString(wParam)
        'VBE编辑器类名wndclass_desked_gsk
        If ClsName = "wndclass_desked_gsk" Then
            '发送关闭消息
            PostMessage wParam, WM_CLOSE, 0, 0
        End If
    End Select
    HookProc = CallNextHookEx(IHook, nCode, wParam, ByVal lParam)
End Function

Private Function GetWindowTextString(ByVal lhWnd As Long) As String
    Dim sTmp As String * 256
    GetWindowText lhWnd, sTmp, 256
    GetWindowTextString = Left$(sTmp, InStr(1, sTmp, vbNullChar) - 1)
End Function

Private Function GetGetClassNameString(ByVal lhWnd As Long) As String
    Dim sTmp As String * 256
    GetClassName lhWnd, sTmp, 256
    GetGetClassNameString = Left$(sTmp, InStr(1, sTmp, vbNullChar) - 1)
End Function

'调试也没拦截到什么。
2011-07-28 19:23
sdhtli
Rank: 1
等 级:新手上路
帖 子:115
专家分:0
注 册:2008-10-6
收藏
得分:0 
新建 Microsoft Excel 工作表.rar (9.35 KB)

谢谢大版主的热情回复,我做了附件麻烦在看看,谢谢
2011-07-29 08:54
sdhtli
Rank: 1
等 级:新手上路
帖 子:115
专家分:0
注 册:2008-10-6
收藏
得分:0 
为什么在关闭vbe编辑器的同时也把Excel 关闭了呢,?
2011-07-30 10:29
快速回复:钩子屏蔽 ExcelVBE编辑器
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.021795 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved