Classic VB6 - Disabling Ctrl+C and Ctrl+V and Ctrl+X in a textbox

[akhileshbc]

Hai guys,
Here is a solution to the common problem of disabling the copy, cut, paste procedures. Many people wants to block this thing for certain purposes. I had came up with some solution after some experiments. I don't whether this is the best solution for that, but I had tested it on a textbox and is working nice

Hope you all will like this one..

Code inside the form:

'Everything in here(this form)is made by me, Akhilesh B Chandran
'---------------------------------------------------------------
'***************************************************************
Dim Hooked As Boolean

Private Sub Form_Load()
Hooked = False 'hooked is used to prevent it from calling the function again and again on each mousemove
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Hooked = True Then
    UnhookMouse
    Hooked = False
End If
End Sub

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Hooked = False Then
    HookMouse
    Hooked = True
End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 22 Then 'paste(ctrl+ v)
    KeyAscii = 0
End If

If KeyAscii = 3 Then 'copy(ctrl + c)
    KeyAscii = 0
End If

If KeyAscii = 24 Then 'cut(ctrl + x)
    KeyAscii = 0
End If
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 45 And Shift = 1 Then KeyCode = 0 'paste(shift + insert)
If KeyCode = 45 And Shift = 2 Then KeyCode = 0 'copy(ctrl + insert)
End Sub

Code inside the module:

'This code is from Hack, I had copied this code from another thread, from where he Hack had posted it
'****************************************************************************************************
'
Public Const WH_MOUSE As Long = 7

'API Declarations
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, _
ByVal lParam As Long) As Long

'Global mouse/keyboard function callback handles
Public g_hMouseHook As Long

Public Sub HookMouse()
g_hMouseHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, App.hInstance, App.ThreadID)
End Sub

Public Sub UnhookMouse()
    If g_hMouseHook Then
        Call UnhookWindowsHookEx(g_hMouseHook)
        g_hMouseHook = 0
    End If
End Sub

Public Function MouseProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    'Mouse Function Hook...
    If idHook < 0 Then
        MouseProc = CallNextHookEx(g_hMouseHook, idHook, wParam, ByVal lParam)
    Else
       ' Debug.Print wParam
        If wParam = 516 Or wParam = 518 Or wParam = 164 Then 'single or double-click of mouse
            'Debug.Print "Left mouse click disabled..."
            'Setting the return value to -1 cancels Mouse input...
            MouseProc = -1
        Else
            MouseProc = CallNextHookEx(g_hMouseHook, idHook, wParam, ByVal lParam)
        End If
    End If

End Function

I had made some changes...
Please give your comments and suggestions..

-Best wishes to all
Akhilesh

[manavo11]

The best way to disable these features is to subclass the textbox.

Otherwise, someone can still right click and do the same things from the context menu. Or someone can use Ctrl+Insert to copy and Shift+Insert to paste.

[akhileshbc]

Manavo11, i had made some changes. Thanks 4 ur suggestion

[manavo11]

Now, if you disable the single and double click, does it even get focus? (I haven't tried, I'm just randomly commenting)

Buuuuuut, since you are subclassing, why not just disable the cut, copy and paste messages instead of disabling the clicking and risking my previous assumption to be true?

[akhileshbc]

Then can u post the code

[manavo11]

I don't have VB installed at the moment on this pc, but it's the same code as yours (assuming it works, I haven't tried it), only instead of catching the messages you have put, you catch these ones:

'Declare up top in the module
Const WM_CUT As Long = &H300
Const WM_COPY As Long = &H301
Const WM_PASTE As Long = &H302

and the checking line will be:

If wParam = WM_CUT Or wParam = WM_COPY Or wParam = WM_PASTE Then

I might have slight mistakes, but you get the idea

[EntityReborn]

ORRRRRR....
You could Lock the textbox on MouseDown event, afterchecking that the button was vbRightButton, and unlock it on MouseUp event.
For Shift or Ctrl combinations, in KeyDown, check if Shift is vbShiftMask or vbCtrlMask, and if so, set shift = 0. No need for messy subclassing then.

[manavo11]

It's not messy! APIs are fun

And in theory it's the most "correct" way to do it, not some work around

[akhileshbc]

Manavo, can u post an attachment of that subclassing method.

[manavo11]

I first have to get a hold of a copy of VB6 since I recently moved and forgot to pack it

Or unless someone can find me a link for that free version that you can't compile? Can't remember what they call it...

[EntityReborn]

It's not messy! APIs are fun

And in theory it's the most "correct" way to do it, not some work around

I agree with you, on all points, yet to a beginner wanting a quick fix, (read, workaround as you put it) mine should do the trick very well. Besides, doesn't subclassing crash the IDE when stopping the project?
(Mind you, there is code out there to avoid that.)

[manavo11]

OK, here goes:

'Module code
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_CUT As Long = &H300
Public Const WM_COPY As Long = &H301
Public Const WM_PASTE As Long = &H302
 
Public lpPrevWndProc As Long
Private lnghWnd As Long
 
Public Sub Hook(hWnd As Long)
    lnghWnd = hWnd
    lpPrevWndProc = SetWindowLong(lnghWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
 
Public Sub UnHook()
    Dim lngReturnValue As Long
    lngReturnValue = SetWindowLong(lnghWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
 
Function WindowProc(ByVal hw As Long, _
                    ByVal uMsg As Long, _
                    ByVal wParam As Long, _
                    ByVal lParam As Long) As Long
 
    Select Case uMsg
        Case WM_CUT, WM_COPY, WM_PASTE
            Exit Function
        Case WM_DESTROY
            UnHook
    End Select
    
    WindowProc = CallWindowProc(lpPrevWndProc, lnghWnd, uMsg, wParam, lParam)
End Function

'form code
 
Option Explicit
 
Private Sub Form_Load()
    Hook Text1.hWnd
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    UnHook
End Sub

And in this example, VB doesn't hang when you hit the stop button instead of closing the form normally

[EntityReborn]

And in this example, VB doesn't hang when you hit the stop button instead of closing the form normally

Is this due to these lines of code?...

...
        Case WM_DESTROY
            UnHook
...

[manavo11]

I tried it without those lines as well and it still didn't hang. Can't remember now in which cases it does hang and in which it doesn't (I also seem to remember it hanging occasionally)

But it doesn't hurt to add that line as well. If you forget to add the unhook calling in the form unload, that line will save a crash (I think)

[EntityReborn]

You just earned credits in my program source code :P I'll be using it in the Color converter in my sig.
I actually have one ammendment for that, for better module usage... instead of exiting function, have it call an event, returning an enum of the event called. This way, you can deal with the data if needed. ( I think)
Edit: check that, this would need to be in a class, and have a callback to do what I mentioned.
Edit: Edit: Ok I got it to crash, while trying to Hook multiple objects. I would think using a collection or array of a usertype would probably get around this...maybe.