ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 5435|回复: 8

禁止自定义窗体弹出API HOOK解决之道!

[复制链接]

TA的精华主题

TA的得分主题

发表于 2006-9-7 23:11 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:Windows API应用

主要特点:1).比较稳定,效率还不错. 2).CPU系统资源占用还算好.

与BUTTON兄的作品稍有差别.

mHYFGSr2.zip (12.07 KB, 下载次数: 97)

点评

知识树索引内容:7楼  发表于 2013-9-26 00:12

TA的精华主题

TA的得分主题

发表于 2006-9-7 23:24 | 显示全部楼层
不能下载呀,stanleypan版主!

TA的精华主题

TA的得分主题

发表于 2006-9-7 23:30 | 显示全部楼层

不错,稳定性要好多了,学习一下。

TA的精华主题

TA的得分主题

 楼主| 发表于 2006-9-7 23:31 | 显示全部楼层

我这边没问题.贴上源代码.

' ************************************************************************
' Routine Name : (Private in Document Module) Sub Workbook_BeforeClose
' Written By   : Stanley Pan
' Programmer   : Stanley Pan[SZ-5509-TESA]
' Date Writen  : 2006-09-07 22:56:44
' Inputs       : Cancel:Boolean -
' Outputs      : N/A
' Description  :自由代码,转载时请保留备注信息.
'              :
'              :
' Called By    :
' ************************************************************************
Private Sub Workbook_Open()
   Call Hook   '挂上钩子函数.
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Call UnHook   '取消钩子函数.
End Sub


'----ModMenuHook----

Option Explicit
' ************************************************************************
' Routine Name : (Private in Document Module) Sub Workbook_BeforeClose
' Written By   : Stanley Pan
' Programmer   : Stanley Pan[SZ-5509-TESA]
' Date Writen  : 2006-09-07 22:56:44
' Inputs       : Cancel:Boolean -
' Outputs      : N/A
' Description  :自由代码,转载时请保留备注信息.
'              :
'              :
' Called By    :
' ************************************************************************
Private Const WH_MOUSE_LL = 14
Private Const HC_ACTION = 0&

Public Const WM_MOUSEFIRST = &H200
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
Public Const WM_MOUSELAST = &H209
Type POINTAPI
   x As Long
   y As Long
End Type
Type MOUSEHOOKSTRUCT
   pt As POINTAPI
   hwnd As Long
   wHitTestCode As Long
   dwExtraInfo As Long
End Type
Private Declare Function WindowFromPoint Lib "User32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private 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
Private Declare Function UnhookWindowsHookEx Lib "User32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "User32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cb 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 m_Hook As Long

Public Sub Hook()
   m_Hook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0&)
   'Application.Hinstance 用0代替或用API函数取得也行
End Sub

Public Sub UnHook()
   UnhookWindowsHookEx m_Hook
End Sub

Public Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
Dim MouseData As MOUSEHOOKSTRUCT
   'Prevent Right-Click in excel Menu!
   If (nCode = HC_ACTION And (wParam = WM_LBUTTONDOWN Or wParam = WM_RBUTTONDOWN)) Then

      Dim sClassName As String
      Dim sTestClass As String
      sTestClass = "EXCEL2"   '菜单空白区域的类为“EXCEL2", 用工具可查到,其实就是要限制的类名.
      sClassName = String$(256, 0)

      CopyMemory MouseData, ByVal lparam, Len(MouseData)   '从内存中取得信息

      '取得当前位置窗体的句柄.
      If GetClassName(WindowFromPoint(MouseData.pt.x, MouseData.pt.y), sClassName, Len(sClassName)) > 0 Then
         If Left$(sClassName, Len(sTestClass)) = sTestClass Then
            LowLevelMouseProc = 1   '禁止成功      'O 为不成功
            Exit Function
         End If
      End If
   End If

   LowLevelMouseProc = CallNextHookEx(m_Hook, nCode, wParam, lparam)

End Function


TA的精华主题

TA的得分主题

 楼主| 发表于 2006-9-8 08:36 | 显示全部楼层
API的方法适用范围更广.WORD,ACCESS ETC 都可以用. 或更改一下屏蔽的类别.

TA的精华主题

TA的得分主题

发表于 2006-9-8 09:17 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

stanleypan兄:WIN NT 沒反應。

以下的代碼中,Cells(1)沒有任何數值導出。
Public Sub Hook()
   m_Hook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, 0, 0&)
   'm_Hook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0&)
   'Application.Hinstance 用0代替或用API函數取得也行
End Sub

Public Sub UnHook()
   UnhookWindowsHookEx m_Hook
End Sub

Public Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lparam As Long) As Long
Dim MouseData As MOUSEHOOKSTRUCT
   'Prevent Right-Click in excel Menu!
   If (nCode = HC_ACTION And (wParam = WM_LBUTTONDOWN Or wParam = WM_RBUTTONDOWN)) Then

      Dim sClassName As String
      Dim sTestClass As String
      sTestClass = "EXCEL2"   '菜單空白區域的類為“EXCEL2", 用工具可查到,其實就是要限制的類名.
      sClassName = String$(256, 0)

      CopyMemory MouseData, ByVal lparam, Len(MouseData)   '從內存中取得信息

      '取得當前位置窗体的句柄.
      If GetClassName(WindowFromPoint(MouseData.pt.x, MouseData.pt.y), sClassName, Len(sClassName)) > 0 Then
         If Left$(sClassName, Len(sTestClass)) = sTestClass Then
            LowLevelMouseProc = 1   '禁止成功      'O 為不成功
            Cells(1) = 1
            Exit Function
         End If
      End If
   End If

   LowLevelMouseProc = CallNextHookEx(m_Hook, nCode, wParam, lparam)
 Cells(1) = 0
End Function

TA的精华主题

TA的得分主题

 楼主| 发表于 2006-9-8 12:32 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

 '经调试Application.Hinstance 用0代替不成功.

'必用API函数取得才行(WORD中不支持Application.Hinstance所以API才是兼容正道)
现公布屏蔽自定义窗体EXCEL 及WORD版.

EXCEL 版:

  miWwSipx.zip (12.5 KB, 下载次数: 54)


[此贴子已经被作者于2006-9-8 19:48:36编辑过]

rHE9Fccs.zip

12.81 KB, 下载次数: 50

TA的精华主题

TA的得分主题

发表于 2006-9-15 08:52 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
QUOTE:
以下是引用stanleypan在2006-9-8 12:32:42的发言:

 '经调试Application.Hinstance 用0代替不成功.

'必用API函数取得才行(WORD中不支持Application.Hinstance所以API才是兼容正道)
现公布屏蔽自定义窗体EXCEL 及WORD版.

EXCEL 版:

 

 謝謝!

TA的精华主题

TA的得分主题

发表于 2007-7-22 12:50 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 16:50 , Processed in 0.055616 second(s), 14 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表