Disable Right Click in Web Control

Edited text of question.

what is your goal ?
do you want the popup menu NOT to popup ?
and if that is correct - is there any mission to do if the left button pressed ?

Yes. We're trying to limit browser functionality so that there is NO wandering around or saving of files possible. The menu that normally appears in IE4 on a right click is to be completely supressed. The left click is still used for navigation.

No URL entry line is provided so that the users cannot specify their destination. As you can see by the code, we have hard coded our internal page. The users can click to anything that we link to and *NOTHING* else. We don't want them exploring the HD, saving wall paper, ANYTHING other than following links.

To navigate back we give them a [Back] button floating over the web. If you want to see what it looks like a modified version is on my web page.

M

' few declarations
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_RBUTTON = &H2

Private Sub doc_onmousedown()
Dim eventObj As IHTMLEventObj
Set eventObj = doc.parentWindow.event
'
If (eventObj.Button = rightButton) Or _
   (eventObj.Button = bothButtons) Then
    MsgBox "ERROR - Operation Forbidden", vbCritical + vbOKOnly, "ERROR!"

agn:
    If GetKeyState(VK_RBUTTON) < 0 Then
        MsgBox "Yea right", vbCritical + vbOKOnly, "ERROR!"
        GoTo agn
    End If
End If
End Sub


Note that there is also keyboard rightclick key (on Win95 keyboards), which isn't stopped.

i tried you code and saw the problem even more then once per 10 times (as a matter of fact - i can popup that menu almost every try... kinda quick with my fingers...or fast machine...)

<<Like some unanticipated event is firing from somehere? >> 
is the best description.

however,

i hate to prompt you for the elementary since you probably spent some time (...:) on this problem, but i must ask it to be sure :

do you know that if you just show your MsgBox Twice - the problem is gone ?

:

Private Sub doc_onmousedown()
'
' Works fine except on Active Server web pages
'
Dim eventObj As IHTMLEventObj
Set eventObj = doc.parentWindow.event

'
If eventObj.button <> 1 Then
  MsgBox "ERROR - Operation Forbidden", vbOKOnly, "ERROR!  "
  MsgBox "ERROR - Operation Forbidden", vbOKOnly, "ERROR!  "
End If

'
End Sub

------------------------------
if you want to be creative - you have more options for the second prompt... :

' doc.parentWindow.alert "ERROR - Operation Forbidden"
 ' doc.parentWindow.confirm "ERROR - Operation Forbidden"

-------------------------------

i had very similar problem 3 years ago with VC++5.0 MFC project, but i can't remember what was it at last. next week i'll see my former partner. maybe he remmembers.

new version, btw, 2 msgboxes is not enough if user presses right click during the second msgbox

' add API declaration
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_RBUTTON = &H2

' modify this function
Private Sub doc_onmousedown()
    Dim eventObj As IHTMLEventObj
    Set eventObj = doc.parentWindow.event
    If (eventObj.Button And rightButton) Then
       ' show warning
       MsgBox "ERROR - Operation Forbidden", vbCritical + vbOKOnly, "ERROR!"
       ' to cheat, user will press rightButton when MsgBox is active
       
agn:
       ' see if rightButton is down
        If GetKeyState(VK_RBUTTON) < 0 Then
            MsgBox "Forbidden 2", vbCritical + vbOKOnly, "ERROR!"
            GoTo agn
        End If
    End If
End Sub

' add this function
Private Sub doc_onkeydown()
    Dim eventObj As IHTMLEventObj
    Set eventObj = doc.parentWindow.event
    ' 93 is keycode when rightclick key is pressed on some keyboards
    If (eventObj.KeyCode = 93) Then
       ' show warning
       MsgBox "ERROR - Operation Forbidden", vbCritical + vbOKOnly, "ERROR!"
    End If
End Sub

'------------------------------
Cheating is still possible if mouse has middle button :-(

ameba :  you are right...
i'm not such sophisticated user to keep the right mouse button pushed during the second MsGBox......

Just to put all this in context, I'm writing code for a telephone call center. We have two shifts of 200 agents that can and do discover *ANY* weakness in the system. We'd thought we'd had everything pretty tightly locked down and this week the wallpaper started changing on stations out on the floor. This, in and of itself, is not a problem, but the other options on this menu include COPY and SAVE. We've had agents corrupt a machine by saving a .JPG or .GIF over a .DLL or .EXE on us! Since there are so many of them and so few of us, it's impossible to tell who did what to a workstation. Anyway we need to plug this hole because once *one* of them figure it out, soon *all* of them are doing it!

I don't really care about the message box being displayed. I'd be just as happy with the click just being ignored, but when I took the message box statement out it failed to block the menu at all. Any alternative is welcome. Is there an application registry switch somewhere we can throw?

M

No systems have a middle button - we've been able to standardize *that* much, but a good solution to the general case would be nice...

M

This can be a good start. If you like the concept, this can be programmed better - with EnumWindows and with additional subclassing code (structures for multiple forms, special debug code ...). Here it is:

' uses subclassing to eat WM_CONTEXTMENU msg
'            (I hate subclassing)
' form code
Option Explicit
'
Public MarginW As Integer      'Offset for slider
Public MarginH As Integer      'Offset for title
'
Public WithEvents doc As HTMLDocument
'
Const leftButton = 1
Const rightButton = 2
Const bothButtons = 3
'
Const navNoHistory          As Integer = 2
Const navNoReadFromCache    As Integer = 4
Const navNoWriteToCache     As Integer = 8

Private Sub Web_DocumentComplete(ByVal pDisp As Object, URL As Variant)
'
Set doc = Web.Document
'
End Sub

Private Sub Btn_Back_Click()
On Error Resume Next
Web.GoBack
'
End Sub

Private Sub Form_Load()

If App.PrevInstance Then Call die
'
Me.Caption = Me.Caption & " - V" & App.Major & "." & App.Minor & "." & App.Revision
'
MarginH = Me.Height - Me.ScaleHeight
MarginW = Me.Width - Me.ScaleWidth
'
Web.Left = 0
Web.Width = Me.Width - MarginW
Web.Height = Me.Height - MarginH - Web.Top
'
'Web.Navigate "http://our.intranet.com", navNoReadFromCache + navNoWriteToCache
Web.Navigate "e:\win95\desktop\daotoadoupdate_topic6.htm", navNoReadFromCache + navNoWriteToCache

' ********************************************
    ' subclass
    ' Subclassing in debug mode is dangerous. Crashes are common.
    WebHwnd = GetHwnd() ' web.hwnd does not work
    If WebHwnd Then
        OldWindowProc = SetWindowLong(WebHwnd, GWL_WNDPROC, AddressOf NewWindowProc)
    Else
        MsgBox "sorry, didn't get WebHwnd"
        die
    End If
' ********************************************
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'
Call die
'
End Sub

Private Sub Form_Resize()
If Me.Width < MarginW Or _
   Me.Height < MarginH Then Exit Sub
'
  Web.Left = 0
 Web.Width = Me.Width - MarginW
Web.Height = Me.Height - MarginH - Web.Top
'
End Sub

Private Sub die()
' ********************************************
    ' Quit subclassing !!!
    SetWindowLong WebHwnd, GWL_WNDPROC, OldWindowProc
' ********************************************
Dim frm As Form
'
For Each frm In Forms
    Unload frm
    Set frm = Nothing
Next frm
'
End
' ========================
' FIN
' ========================
End Sub

Private Sub Web_OnMenuBar(ByVal MenuBar As Boolean)
MenuBar = False
End Sub

' get hwnd of the web control
Public Function GetHwnd() As Long
' web.hwnd property does not work
' real hwnd can be found by accessing child windows
' Form.Hwnd
'    Shell Embedding
'       Shell DocObject View
'          Internet Explorer_Server  <<<< the real one
' (this can be better if we use enumwindows API)
    Dim strBuf As String, i As Long
    GetHwnd = Me.hwnd ' start from forms hwnd
    ' It's first child is the 1st control window
    GetHwnd = GetWindow(GetHwnd, GW_CHILD)
   
    ' Now check all child windows
    Do
        ' check class name
        strBuf = ClassName(GetHwnd)
        Debug.Print strBuf & ": " & Hex(GetHwnd)
        If strBuf = "Shell Embedding" Then ' found
            Exit Do
        End If
        ' retrieve next child
        GetHwnd = GetWindow(GetHwnd, GW_HWNDNEXT)
    Loop While GetHwnd <> 0
   
    If GetHwnd = 0 Then Exit Function
    For i = 1 To 2
        DoEvents
        DoEvents
        GetHwnd = GetWindow(GetHwnd, GW_CHILD)
        Debug.Print Space(3 * i) & ClassName(GetHwnd) & ": " & Hex(GetHwnd)
    Next
End Function

'---------------------------------------
' Module code
Option Explicit
Public OldWindowProc As Long
Public WebHwnd As Long
' for getting hwnd of web control
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_CONTEXTMENU = &H7B
' for subclassing
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Const GW_CHILD = 5
Public Const GW_HWNDNEXT = 2

Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Pass along all messages except the one that
' makes the context menu appear.
    If msg <> WM_CONTEXTMENU Then _
        NewWindowProc = CallWindowProc(OldWindowProc, _
        hwnd, msg, wParam, lParam)
End Function

Public Function ClassName(hwnd As Long) As String
' returns class name
    Dim strBuffer As String, lngRet As Long
    strBuffer = String$(256, 0) ' initialize buffer
    lngRet = GetClassName(hwnd, strBuffer, 255)
    If lngRet > 0 Then
        ClassName = Left$(strBuffer, lngRet)
    End If
End Function

Sorry for answering, I pressed wrong button. You can reject it.

OK. i belive i have it all set and done now :

tnx to AMEBA, i've noticed that the problem occures when the RightMouse button is pushed BEFORE and DURING the ESC key pressed !!
then, when the Button RELEASED - the popup menu pops up !!!

that means that the pop up pops as a result of MouseUp(!!!) event, and not the Down event.

now, since you don't need that MsgBox, all you have to do is to DELETE the MouseDown Code and add the folowing instead :

--------------------------
Private Sub doc_onmouseup()
    Dim eventObj As HTMLDocument
    Set eventObj = doc.parentWindow.event
    If eventObj.button = 2 Then SendKeys "{ESC}"
End Sub
-------------------------
the ESC - closing the popup.

as simple as it is - that's doing the job....

I hope mark2150 is testing all this.

I have a new version of module code (I hope my code worked). In subclassing I replaced rightbutton msg with middlebutton message, and now right button has great auto-scrolling capabilities normally assigned to middle mouse.

I'll post the code if you want.

ameba : i hope you test my last comment... it's only 3 lines of code + deleting 1 sub from original code...

I'll test it.

It's type error:
    Dim eventObj As IHTMLEventObj ' not HTMLDocument

and it doesn't work.

Now, you can test my code (add module ..). HEHEHE

ameba : you are wrong !!
in Mark2150 ORIGINAL code there is :
------
Public WithEvents doc As HTMLDocument
-------------

if you get a type error - add the "Microsoft HTML Object Library" control or ref.

however - it DO WORKS even like this :
-------------------------
Private Sub doc_onmouseup()
    Dim eventObj
    Set eventObj = doc.parentWindow.event
    If eventObj.button = 2 Then SendKeys "{ESC}"
End Sub
---------------------------
if now you get the type error - it's Mark to blame....
-----------------------------
as it works just great - i've no reason to test other codes(heheheh... :), till i'll be proved diffrent.....

AnswerTheMan first wrote:
>Dim eventObj As HTMLDocument
ameba said:
>Dim eventObj As IHTMLEventObj ' not HTMLDocument
AnswerTheMan than wrote:
>Dim eventObj

But it doesn't work, ESC is sent before menu appears.
>i've no reason to test other codes
This is not fair... :-)
Or at least you should test your code (A-HA)
------------------------------------
I also tried instead of MsgBox:
1. PopupMenu yourownmenu (and it works)

2. Autocorrect button state - by using keyboard_event
(it works, but it flushes outline of menu for ... cca 0.01 seconds)

3. Subclassing (actually I tried this first, but I wasn't able to get HWND of Web control)
By using Spy++ tool, I saw Spy was able to find hwnd - I used its finder tool and saw real window is deep in window structure.

Maybe it is possible to get hwnd by using GetFocus in Form_Activate. I tried only the hard way (using GW_CHILD 3 x).

<<
But it doesn't work, ESC is sent before menu appears.
>>

if it does not work - it's amazing, because i've tested it on 2 machines (NT,95,both ie5), and it works perfect.

now, ESC is *NOT* "sent" before menu appears because i did not write :
SendKeys "{ESC}", True
i've just wrote :
SendKeys "{ESC}"

if you like to know the diffrence :

Syntax

SendKeys string[, wait]

Wait: Optional.Boolean value specifying the wait mode. If False (default), control is returned to the procedure immediately after the keys are sent. If True, keystrokes must be processed before control is returned to the procedure.

read this couple of times. the ESC is "send", but the keystroke implementation occures after the menu is shown.

 

I tried it both before. So it must be my machine/IE setting. I tried it also in debug mode to see what happens.

I am glad you tried it also. I thought you didn't.

Added code to unsubclass/subclass again when window is destroyed.

Ok guys, I'll give *BOTH* of these a test when I get into the office tomorrow and let you know.

Ameba, I'm rejecting for now, but if it works I'll Grade Comment as Answer.

Thanx guys!

M

AnswerTheMan,

Your solution works *GREAT*, but *ONLY* when I'm over a graphic! If I right click elsewhere on the HTML page I get the !@#$%^ menu!

I also had to change:

Dim eventObj As HTMLDocument

into

Dim eventObj As IHTMLEventObj

to get it to work at all, but it only stops the menu from appearing if they click over a graphic. I need to stop it *TOTALLY*.

ameba,

All I get when I run your code is the "sorry" dialog...

M

PS
I'm using VB5(SP3)

M

VB6 and IE4 here.
It must be the wrong class names if you are using IE5.
Perhaps web.hwnd works in IE5, than you can delete GetHwnd function.
Or you can use Spy to see correct class names.

The idea is from here:
Disable a TextBox's context menu (1K)
(http://www.vb-helper.com/HowTo/noctxmnu.zip
from
http://www.vb-helper.com/HowToAdv.htm

AnswerTheMan!

You'v got it!

I added your code to *BOTH* the mouse up and down events and it seems to work!

Give me a day to test and I'll award.

Meanwhile, ameba, let me know if you can get it working...

M

>let me know if you can get it working
It works nice here, but sorry I can't test it on IE5.

Just a quickie guys... Can't you just subclass the IE window and catch and ignore rightmousedown messages?

This is the idea I used.

Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Pass along all messages except the one that
' makes the context menu appear.
' Also, process right button messages
    If msg = WM_CONTEXTMENU Then
    ElseIf msg = WM_RBUTTONDOWN Then
    ElseIf msg = WM_RBUTTONUP Then
        If Form1.Scroll Then
            MouseFullClick btcMiddle
        End If
    ElseIf msg = WM_DESTROY Then
        Debug.Print "destroy"
        NewWindowProc = CallWindowProc(OldWindowProc, hwnd, msg, wParam, lParam)
        Form1.UnSubclass
        Form1.Subclass
    Else
        ' do default processing
        NewWindowProc = CallWindowProc(OldWindowProc, hwnd, msg, wParam, lParam)
    End If
End Function

The problem is in getting hwnd of the webbrowser control.
web.hwnd does not work! (in IE4)

I solved it by using GetHwnd function, but it doesn't work with IE5.

Ameba, IE4 is what we're using underlying the app.

AnswerTheMan, It works a *LOT* better, but *NOT* perfectly. I challenged one of my users to "Beat this!" and he *did* within a few minutes. But he was unable to beat it consistently. I watched him fuss over it for 15 minutes or so and he couldn't do it a 2nd time.

Note to M$: Why is this *SO TOUGH*?

Ameba, are you saying that if I code GetHwnd it'll work in IE4 but when we move to IE5 i'll have to change to web.hwnd instead?

M

Sorry, I don't know.
If you are saying you use IE4 for testing and sending Escape works, than it's something different on my PC.

Here, menu is shown AFTER mouseup event.

Maybe it's my mouse driver ... at a moment I am using old Genius mouse.

mark2150:
i'm using VB6(SP3), with IE5.0,

tested that on NT4.0(SP4)+IE5 and WIN95+IE5.

doing all that - deleting your mouseDOWN event and adding mouseUP event :

Private Sub doc_onmouseup()
    Dim eventObj
    Set eventObj = doc.parentWindow.event
    If eventObj.button = 2 Then SendKeys "{ESC}"
End Sub

IS DOING THE JOB in 100% (tried to play with it as a user and could not make the menu to pop up), NOT ONLY ON GRAHPHICS, BUT ON THE *ENTIRE* doc.

"Microsoft HTML Object Library" is included in my test project.

since you don't have 100% success, i can only imagaine that it's a matter of VB version, Controls and reffrences Versions, and\or IE version.
i can't test it under your Versions, so i think i have nothing more to contibute....

Regarding the subclassing way(s) suggested :
well, since it's just a MouseUP event - it's just a matter of simple event handling that was made on the wrong event.
one more last thing : the event code must be as short and light as possible.
event which it's code accessed before privious same event code is completed -
will lead to Unpredictible results.
here is what MSDN say about this :
<<
Caution   Any time you temporarily yield the processor within an
event procedure, make sure the procedure is not executed again from
a different part of your code before the first call returns;
this could cause unpredictable results.
>>

good luck

M, one thing:
- In Form_Load put line: Web.Navigate "..."
after subclassing

You can also see debug window, if GetHwnd worked, you'll see these classnames:
ThunderCheckBox: 728
ThunderCommandButton: 72C
Shell Embedding: 730
   Shell DocObject View: 73C
      Internet Explorer_Server: 748

AnswerTheMan

Gotta be a difference in IE4 and IE5. We're on IE4 and when I take out the MouseDown event it triggers the menu on the *EVERY RIGHT CLICK NOT OVER A GRPAHIC* on a freshly displayed page!

ameba, no time to check it tonight. I'm out Monday & Tuesday so it'll be Wednesday at earliest before I can recheck your method, sorry.

M

what a coincidence !!!!! :::
just now my wife complained that when she tries to save some graphics from a site she's in  - when she right-click the mouse - she gets a "This Function is disabled" MsgBox....
she asked me if that's some virus in her machine........:))))))))))

so, i've just told her to keep the right-button pushed down, hit ESC key, and then- release the Right button.

well, now she's saving all that site's graphics..........

ain't that something ?????

:-)

LOL!

M

Anyway, back at the office today. AnswerTheMan's solution is 99% effective. It's that last 1% I'm trying to conquer. :-(

Ok, lets pick this back up. Ameba can you please resend me the project file to my work email: Mark_Lambert@Faneuil.com ? I appreciate the efforts!

AnswerTheMan, any other ideas?

M

can't test it ubder IE4.x.
all around me there are machins with IE5.0  .
the solution is 100% on IE5.0 , and i don't want to start "DownGrading" any of those machins now, to test it on 4.x  .
can you put your finger on the user action leading to that 1% ?  can you reproduce (hope that's the word) it ?

I sent it, hope you are still at the office.

just a shot in the dark regarding the missing 1% :

assuming that the popup menu is activated by some IE DLL -

if it's the first time this DLL is loaded to catch - it's takes a little extra time then next times - in this period the *SendKeys "{ESC}" * can be a blank shot.

the wait mode of the SendKeys is FALSE (default) which means that it will be normally fired AFTER the popup menu displayed. if there is a delay - it'll be fired BEFORE the menu appear.

maybe it's that missing 1%.

if you can verify that that's the case -
one thing that can be done is to LOAD that dll on first runtime load action.

P.S :
second thought : if the action is *FORBIDEN* - you can SendKeys ALT+F4 after the msgbox.....the punishment affect will teach the user a lesson not to try it again......  :))))

Well, found out from my hacker user how he's doing it. He can only do it while the page is still loading.

Maybe we can check the state of Web.Busy?

M

your man is right. 2 ways :


1.
WEB.Navigate "https://www.experts-exchange.com/jsp/qShow.jsp?ta=visualbasic&qid=10235809 ", navNoReadFromCache + navNoWriteToCache
Do While WEB.Busy = True
    DoEvents
Loop

2.
add a Global : Private DONE as Boolean
 then, in your Web_DocumentComplete event  add : DONE=True
then, in the Load event :

WEB.Navigate "https://www.experts-exchange.com/jsp/qShow.jsp?ta=visualbasic&qid=10235809 ", navNoReadFromCache + navNoWriteToCache
Do While Not DONE
    DoEvents
Loop


each way the doc will be displayed ONLY when loaded which takes time sometimes...
however, tried that 3-4 times (each) and it seems to me that 2nd way is faster. maybe the WEB.BUSY is true a while after the doc is actually loaded so why wait for it when you have a doc_complete event ?

each way prevents 100% the popup menu.

BTW : i've checked on the site i've mentioned some comments ago, and it is handled there via JavaScript on the wrong event also....but they wrong only regading IE. on Netscp it is doin the job, so BOTH events should be taken care.

Hmmm. How about:

Web.Visible = false
Web.Navigate "my URL"
do while web.busy
  doevents
loop
web.visible = true

It'll *BLINK* off and on, but they can't click on it if it isn't VISIBLE!

I'll have to give this a test monday...

M

<<"maybe the WEB.BUSY is true a while after the doc is actually loaded so why wait for it when you have a doc_complete event ?">>

Even better!

M

Well, I put:

Private Sub Web_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
Web.Visible = False
'
End Sub

Private Sub Web_DocumentComplete(ByVal pDisp As Object, URL As Variant)
'
Set doc = Web.document
Web.Visible = True
'
End Sub

And they're *STILL* able to grab the menu if they right click on an image while it's loading. If I take out Wb.Visible in Download complete the screen never shows as Document_Complete can't seem to fire until after the page has been rendered. (sigh).

M

I added debug.print statements to see the sequence of events. And it seems that the mouse events are *NOT* firing if you can right click in during the time that an image is rendering. I got a sequence where the BeforeNaviagate2 fires

' User clicks on a link
'
Before Nav    http://daybdc.faneuil.com/events.html#team
Download Complete
Document Complete
'
' User clicks on a picture
'
Mouse Down1
Mouse up1
Before Nav    http://daybdc.faneuil.com/art/team2.gif
'
' Now right in here we caught the image as it was loading
' and right click popped the menu. Note that there is no
' mouse events here. The GoBack is the back button clicked
' I was able to repeatedly display the menu as long as I
' stayed over the image even after it had completed loading
' But the mouse events are NOT firing!
'
Download Complete
Go Back
'
' We return to the parent page.
'
Before Nav    http://daybdc.faneuil.com/events.html#team
Download Complete
Document Complete

M

Ok, concept is to simply *cover* the underlying "live" page with something else while it stabilizes...

Hmmm. Will have to check that.

Let me try at the office tomorrow.

M

hey, i've just noticed that it's 'proposed answer' and not a 'comment'. that was a MISTAKE. clicked the wrong radio button.
feel free to reject that.

Give this a shot and see if it meets your needs.  This way, the right click  is simply thrown out.  Subclass windows to intercept the mouse click.  Use the following code:

'Insert this into the form that contains your webbrowser:

Private Sub Form_Load()
    'Start Trapping Right-Mouse clicks in WebBrowser Control:
    gLngMouseHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseHookProc, App.hInstance, GetCurrentThreadId)

End Sub

Private Sub Form_Unload(Cancel As Integer)
'Cancel the trapping of the code
UnhookWindowsHookEx gLngMouseHook

End Sub


'Add this to a BAS module:

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
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
     
Public Const WM_RBUTTONUP = &H205
Public Const WH_MOUSE = 7

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type
     
Public gLngMouseHook As Long
     
Public Function MouseHookProc(ByVal nCode As Long, ByVal wParam As Long, mhs As MOUSEHOOKSTRUCT) As Long
Dim strBuffer As String
Dim lngBufferLen As Long
Dim strClassName As String
Dim lngResult As Long

If (nCode >= 0 And wParam = WM_RBUTTONUP) Then

        'Preinitialize string
        strBuffer = Space(255)
         
       ' lngBufferLen = Len(strBuffer)
         
        'This is the string that holds the class name that we are looking for
        strClassName = "Internet Explorer_Server"
         
        Debug.Print strClassName
         
        'Get the classname for the Window that has been clicked, making sure something is returned
        'If the function returns 0, it has failed
        lngResult = GetClassName(mhs.hwnd, strBuffer, Len(strBuffer))
                 
        Debug.Print Left$(strBuffer, lngResult)
                 
        If lngResult > 0 Then

            'Check to see if the class of the window we clicked on is the same as above
            If Left$(strBuffer, lngResult) = strClassName Then
                 
                'Value is the same. Squash the command
                MouseHookProc = 1
                 
                Exit Function
                 
            End If
             
        End If

    End If

MouseHookProc = CallNextHookEx(gLngMouseHook, nCode, wParam, mhs)
End Function

It's gonna take a day or two to try this. Thanx for the input. We've been ripping our hair out over this one...

M

thank you 'EE answering machine.....'..
have not been around lately and what a refreshing new feature......

Sorry for not getting back on this, but haven't been able to test at work yet.

As for not being the "answering machine" was on a cruise over the holidays and for some unknown reason E-E from work (with a T1) is mud s-l-o-w but at home with a 56k its running faster! (go figure!) So I'm not answering as much during the day as a 2 minute wait for a Q to appear or a comment to post is more than my frustration limit can handle! :-(

M

Solution by implementing IDocHostUIHandler Interface
http://codeguru.developer.com/bbs/wt/showpost.pl?Board=vb&Number=6016&page=0&view=collapsed&sb=5

Anyone else looking at this question might like to know I wanted to do the same thing and it took me 5 minutes to implement the subclassing as shown by jjmartin. Quick and easy answer.

Cheers