监视剪贴板.bas

个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助

Attribute VB_Name = "Module1"
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd 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
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 Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function ChangeClipboardChain Lib "user32" (ByVal hwnd As Long, ByVal hWndNext As Long) As Long
Public Declare Function SetClipboardViewer Lib "user32" (ByVal hwnd As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_DRAWCLIPBOARD = &H308
Public Const WM_CHANGECBCHAIN = &H30D
Public lpPrevWndProc As Long
Public lClipboardChain As Long
Public Sub Hook(hwnd As Long)
    lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf windowproc)
    lClipboardChain = SetClipboardViewer(hwnd)
End Sub
Public Sub UnHook(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, lpPrevWndProc
    ChangeClipboardChain hwnd, lClipboardChain
End Sub
Public Function windowproc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
        Case WM_DRAWCLIPBOARD
            SendMessage lClipboardChain, WM_DRAWCLIPBOARD, 0, 0
            MsgBox "ClipBoard already changed", vbInformation
        Case WM_CHANGECBCHAIN
            If lClipboardChain = wParam Then
                lClipboardChain = lParam
            End If
        Case Else
            windowproc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
    End Select
End Function