钩子屏蔽 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