home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD99699192000.psc / source / Module1.bas < prev    next >
Encoding:
BASIC Source File  |  2000-08-04  |  3.4 KB  |  126 lines
  1. Attribute VB_Name = "Module1"
  2.  
  3. 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
  4.  
  5.  
  6. Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  7.  
  8.  
  9. Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
  10.  
  11.  
  12. Declare Function GetCurrentThreadId Lib "kernel32" () As Long
  13.  
  14.  
  15. Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  16.     Public Const WM_RBUTTONUP = &H205
  17.     Public Const WH_MOUSE = 7
  18.  
  19.  
  20. Type POINTAPI
  21.     x As Long
  22.     y As Long
  23.     End Type
  24.  
  25.  
  26. Type MOUSEHOOKSTRUCT
  27.     pt As POINTAPI
  28.     hwnd As Long
  29.     wHitTestCode As Long
  30.     dwExtraInfo As Long
  31.     End Type
  32.     Public l_hMouseHook As Long
  33.                             
  34.  
  35.  
  36.  
  37.  
  38.                         
  39. '**************************************
  40. ' Name: Disable Right Mouse click
  41. ' Description:Disable Right Mouse click
  42. '     in the web browser control.
  43.  
  44. ' By: Newsgroup Posting
  45. '
  46. '
  47. ' Inputs:None
  48. '
  49. ' Returns:None
  50. '
  51. 'Assumes:None
  52. '
  53. 'Side Effects:None
  54. '
  55. 'Warranty:
  56. 'code provided by Planet Source Code(tm)
  57. '     (http://www.Planet-Source-Code.com) 'as
  58. '     is', without warranties as to performanc
  59. '     e, fitness, merchantability,and any othe
  60. '     r warranty (whether expressed or implied
  61. '     ).
  62. 'Terms of Agreement:
  63. 'By using this source code, you agree to
  64. '     the following terms...
  65. ' 1) You may use this source code in per
  66. '     sonal projects and may compile it into a
  67. '     n .exe/.dll/.ocx and distribute it in bi
  68. '     nary format freely and with no charge.
  69. ' 2) You MAY NOT redistribute this sourc
  70. '     e code (for example to a web site) witho
  71. '     ut written permission from the original
  72. '     author.Failure to do so is a violation o
  73. '     f copyright laws.
  74. ' 3) You may link to this code from anot
  75. '     her website, provided it is not wrapped
  76. '     in a frame.
  77. ' 4) The author of this code may have re
  78. '     tained certain additional copyright righ
  79. '     ts.If so, this is indicated in the autho
  80. '     r's description.
  81. '**************************************
  82.  
  83.  
  84.  
  85. Public Function MouseHookProc(ByVal nCode As Long, ByVal wParam As Long, mhs As MOUSEHOOKSTRUCT) As Long
  86.     'Prevent Right-Mouse Clicks in WebBrowse
  87.     '     r Control:
  88.  
  89.  
  90.     If (nCode >= 0 And wParam = WM_RBUTTONUP) Then
  91.         Dim sClassName As String
  92.         Dim sTestClass As String
  93.         sTestClass = "HTML_Internet Explorer"
  94.         sClassName = String$(256, 0)
  95.  
  96.  
  97.         If GetClassName(mhs.hwnd, sClassName, Len(sClassName)) > 0 Then
  98.  
  99.  
  100.             If Left$(sClassName, Len(sTestClass)) = sTestClass Then
  101.                 MouseHookProc = 1
  102.                 Exit Function
  103.             End If
  104.         End If
  105.     End If
  106.     MouseHookProc = CallNextHookEx(l_hMouseHook, nCode, wParam, mhs)
  107. End Function
  108.  
  109.  
  110. Public Sub BeginRightMouseTrap()
  111.     'Start Trapping Right-Mouse clicks in We
  112.     '     bBrowser Control:
  113.     l_hMouseHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseHookProc, App.hInstance, GetCurrentThreadId)
  114. End Sub
  115.  
  116.  
  117. Public Sub EndRightMouseTrap()
  118.     'End Trapping Right-Mouse clicks in WebB
  119.     '     rowser Control:
  120.     UnhookWindowsHookEx l_hMouseHook
  121. End Sub
  122.  
  123.  
  124.  
  125.  
  126.