【转自csdn】禁止操作者在文本框中粘贴文本,要求他们必须手工输入的实现

方法1：在文本框获得焦点的时候清空剪贴板
即在文本得到焦点clipboard.Clear
方法2：子类化拦截消息
拦截代码1
复制粘贴用的是WM_COPY,   WM_PASTE两个消息，可以直接子类化拦截
新建一工程,在默认窗体上放一个文本框,名称不改,Text1:

Option   Explicit

Private   Sub   Form_Load()
        PrevWndProc   =   SetWindowLong(Text1.Hwnd,   GWL_WNDPROC,   AddressOf   SubWndProc)
End   Sub

Private   Sub   Form_Unload(Cancel   As   Integer)
        SetWindowLong   Text1.Hwnd,   GWL_WNDPROC,   PrevWndProc
End   Sub

窗体代码OK.然后新建一个标准模块,放以下代码进去:

Option   Explicit

Public   Declare   Function   SetWindowLong   Lib   "user32 "   Alias   "SetWindowLongA "   (ByVal   Hwnd   As   Long,   ByVal   nIndex   As   Long,   ByVal   dwNewLong   As   Long)   As   Long
Public   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
Public   Const   GWL_WNDPROC   =   (-4)
Public   Const   WM_GETTEXT   =   &HD
Public   Const   WM_COPY   As   Long   =   &H301
Public   Const   WM_PASTE   As   Long   =   &H302

Public   PrevWndProc   As   Long

Public   Function   SubWndProc(ByVal   Hwnd   As   Long,   ByVal   MSG   As   Long,   ByVal   wParam   As   Long,   ByVal   lParam   As   Long)   As   Long
        Select   Case   MSG                   '在这里进行过滤.如果知道其他的消息,也可以在这里过滤. 
                Case   WM_COPY,   WM_PASTE,   WM_CUT  '过率复制、粘贴、剪切消息
                        SubWndProc   =   1
                        Exit   Function
        End   Select
        SubWndProc   =   CallWindowProc(PrevWndProc,   Hwnd,   MSG,   wParam,   lParam)           '其它消息不管
End   Function


拦截代码2
子类化拦截WM_COPY,   WM_PASTE
Public Function CheckText(KeyIn As Integer, InValidateString As String, NY As Boolean, Editable As Boolean) As Integer
'输入过滤
'KeyIn              是KeyAscii值
'InValidateString   字符列表
'NY                 true ：只能输入InValidateString中的字符
'                   False：只能输入InValidateString中的没有的字符
'Editable           只否可以使用编辑键
   On Error GoTo myerr
    Dim ValidateList As String
    Dim KeyOut As Integer
    If KeyIn  < 0 Then
        CheckText = 0
        Beep
        Exit Function
    End If
    If Editable = True Then
         ValidateList = UCase(InValidateString) & Chr(8)
    Else
         ValidateList = UCase(InValidateString)
    End If
    If NY Then
      If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) > 0 Then
          KeyOut = KeyIn
      Else
          KeyOut = 0
          Beep
      End If

     Else
      If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) = 0 Then
          KeyOut = KeyIn
      Else
          KeyOut = 0
          Beep
      End If
    End If
    CheckText = KeyOut
Exit Function
myerr:
End Function


Private Sub Text1_KeyPress(KeyAscii As Integer)
     KeyAscii = CheckText(KeyAscii, "1234567890", True, True)
'或  KeyAscii = CheckText(KeyAscii, "1234567890",False , False)
End Sub

拦截代码4
  一个模块,一个窗体:  
  模块代码:  
  Option   Explicit  
  Public   Declare   Function   GetWindowLong   Lib   "user32"   Alias   "GetWindowLongA"   (ByVal   hwnd   As   Long,   ByVal   nIndex   As   Long)   As   Long  
  Public   Declare   Function   SetWindowLong   Lib   "user32"   Alias   "SetWindowLongA"   (ByVal   hwnd   As   Long,   ByVal   nIndex   As   Long,   ByVal   dwNewLong   As   Long)   As   Long  
  Private   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  
  Private   Const   WM_PASTE   =   &H302  
  Public   Const   GWL_STYLE   =   (-16)  
  Public   Const   ES_NUMBER   =   &H2000  
  Private   Const   GWL_WNDPROC   =   (-4)  
   
  Dim   OldWndProc   As   Long  
   
  Public   Sub   StartSubclass(ByVal   hwnd   As   Long)  
        OldWndProc   =   SetWindowLong(hwnd,   GWL_WNDPROC,   AddressOf   SubClassProc)  
  End   Sub  
     
   
  Public   Sub   EndSubclass(ByVal   hwnd   As   Long)  
        If   OldWndProc   <>   0   Then  
              Call   SetWindowLong(hwnd,   GWL_WNDPROC,   OldWndProc)  
              OldWndProc   =   0  
        End   If  
  End   Sub  
     
   
     
   
  Private   Function   SubClassProc(ByVal   hwnd   As   Long,   ByVal   wMsg   As   Long,   ByVal   wParam   As   Long,   ByVal   lParam   As   Long)   As   Long  
        Select   Case   wMsg  
        Case   WM_PASTE  
              Debug.Print   "吃掉了WM_PASTE消息"  
        Case   Else  
              SubClassProc   =   CallWindowProc(OldWndProc,   hwnd,   wMsg,   wParam,   lParam)  
        End   Select  
  End   Function  
     
  窗体(有一个textbox)代码:  
  Option   Explicit  
   
   
  Private   Sub   Form_Load()  
          Dim   style   As   Long  
          style   =   GetWindowLong(Text1.hwnd,   GWL_STYLE)  
          style   =   style   Or   ES_NUMBER  
          SetWindowLong   Text1.hwnd,   GWL_STYLE,   style  
          text1.text=""  
          StartSubclass   Text1.hwnd  
  End   Sub  
   
   
  Private   Sub   Form_Unload(Cancel   As   Integer)  
          EndSubclass   Text1.hwnd  
  End   Sub

方法3：对文本框设置键盘HOOK
代码如下：
' '本段代码原作者　Modest(塞北雪貂)
' '阿勇略添加一点点代码
Option   Explicit
'判断函数调用时指定虚拟键的状态
'获得拥有输入焦点的窗口的句柄
Public   Declare   Function   GetFocus   Lib   "user32 "   ()   As   Long
Public   Declare   Function   GetAsyncKeyState   Lib   "user32 "   (ByVal   vKey   As   Long)   As   Integer
Public   Declare   Function   GetWindowLong   Lib   "user32 "   Alias   "GetWindowLongA "   (ByVal   hwnd   As   Long,   ByVal   nIndex   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
Public   Const   GWL_WNDPROC   =   (-4)
Public   Const   WH_MOUSE   =   7
Public   Const   WH_KEYBOARD   =   2
Public   Const   WM_RBUTTONDOWN   =   &H204
Public   Const   VK_CONTROL   As   Integer   =   &H11

Public   lngMHook   As   Long
Public   lngKHook   As   Long

'屏蔽鼠标右键功能
Function   MouseProc(ByVal   idHook   As   Long,   ByVal   wParam   As   Long,   ByVal   lParam   As   Long)   As   Long
If   GetFocus   <>   Form1.Text1.hwnd   Then   Exit   Function   'Form1.Text1.hwnd换成你想控制的textbox
If   idHook   <   0   Then
        MouseProc   =   CallNextHookEx(lngMHook,   idHook,   wParam,   ByVal   lParam)
Else
        Select   Case   wParam
        Case   WM_RBUTTONDOWN
                MouseProc   =   1
                Exit   Function
        Case   Else
        End   Select
        MouseProc   =   CallNextHookEx(lngMHook,   idHook,   wParam,   ByVal   lParam)
End   If
End   Function

Function   KeydownProc(ByVal   idHook   As   Long,   ByVal   wParam   As   Long,   ByVal   lParam   As   Long)   As   Long
If   GetFocus   <>   Form1.Text1.hwnd   Then   Exit   Function   'Form1.Text1.hwnd换成你想控制的textbox

If   idHook   <   0   Then
        KeydownProc   =   CallNextHookEx(lngKHook,   idHook,   wParam,   ByVal   lParam)
Else
        Debug.Print   wParam,   lParam
        Select   Case   wParam
        Case   93     '屏蔽键盘右键功能
                KeydownProc   =   1
                Exit   Function
        Case   vbKeyV
                If   GetAsyncKeyState(VK_CONTROL)   Then
                        KeydownProc   =   1
                        Exit   Function
                End   If
        Case   Else
        End   Select
        KeydownProc   =   CallNextHookEx(lngKHook,   idHook,   wParam,   ByVal   lParam)
End   If
End   Function

窗口中代码
Private   Sub   Form_Load()
'屏蔽鼠标右键的功能
lngMHook   =   SetWindowsHookEx(WH_MOUSE,   AddressOf   MouseProc,   App.hInstance,   App.ThreadID)

'屏蔽键盘中模拟鼠标右键功能的按键
lngKHook   =   SetWindowsHookEx(WH_KEYBOARD,   AddressOf   KeydownProc,   App.hInstance,   App.ThreadID)
End   Sub

Private   Sub   Form_Unload(Cancel   As   Integer)
'窗体退出,还原钩子函数

Dim   l   As   Long

If   lngMHook   Then
l   =   UnhookWindowsHookEx(lngMHook)
lngMHook   =   0
End   If

If   lngKHook   Then
l   =   UnhookWindowsHookEx(lngKHook)
lngKHook   =   0
End   If

End   Sub
方法4：
檢測到昰右鍵,   使用sendkeys  
   
  Private   Sub   txtUserNo_KeyPress(KeyAscii   As   Integer)  
          If   KeyAscii   =   vbKeyReturn   Then  
                  SendKeys   "{Tab}"  
                  KeyAscii   =   0  
          End   If  
   
  End   Sub