Attribute VB_Name = "Module1"
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 Declare Function SetClipboardViewer Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function ChangeClipboardChain Lib "user32" (ByVal hWnd As Long, ByVal hWndNext 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 Long) As Long
Public Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean

Public Type tagInitCommonControlsEx
 lngSize As Long
 lngICC As Long
End Type

Public Const GWL_WNDPROC = (-4&)
Public Const WM_SYSCOMMAND = &H112
Public Const WM_DRAWCLIPBOARD = &H308
Public Const WM_CHANGECBCHAIN = &H30D
Public Const ICC_USEREX_CLASSES = &H200

Public old_window_procedure As Long
Public next_clipboard_viewer As Long
Public clipboard_is_hooked As Boolean
Public frm1 As Form1

Public Sub Main()
 On Error GoTo 0
 Dim iccex As tagInitCommonControlsEx
 iccex.lngSize = LenB(iccex)
 iccex.lngICC = ICC_USEREX_CLASSES
 InitCommonControlsEx iccex
 Set frm1 = New Form1
 Load frm1
 frm1.Show
End Sub

Public Function hook_clipboard(ByVal window_handle As Long) As Boolean
 old_window_procedure = SetWindowLong(window_handle, GWL_WNDPROC, AddressOf new_window_procedure)
 next_clipboard_viewer = SetClipboardViewer(window_handle)
 If (old_window_procedure <> 0) Then
  hook_clipboard = True
 Else
  hook_clipboard = False
 End If
End Function

Public Function unhook_clipboard(ByVal window_handle As Long) As Boolean
 If (next_clipboard_viewer <> 0) Then
  Call ChangeClipboardChain(window_handle, next_clipboard_viewer)
 End If
 If (old_window_procedure <> 0) Then
  Call SetWindowLong(window_handle, GWL_WNDPROC, old_window_procedure)
 End If
 unhook_clipboard = False
End Function

Public Function new_window_procedure(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 Select Case Msg
  Case WM_CHANGECBCHAIN
   If wParam = next_clipboard_viewer Then
    next_clipboard_viewer = lParam
   ElseIf (next_clipboard_viewer <> 0) Then
    Call SendMessage(next_clipboard_viewer, Msg, wParam, lParam)
   End If
  Case WM_DRAWCLIPBOARD
   If Clipboard.GetFormat(vbCFText) Then
    frm1.Text1.Text = frm1.Text1.Text & Left$(Clipboard.GetText, 32767) & vbNewLine
   End If
   If (next_clipboard_viewer <> 0) Then
    Call SendMessage(next_clipboard_viewer, Msg, wParam, lParam)
   End If
 End Select
 new_window_procedure = CallWindowProc(old_window_procedure, hWnd, Msg, wParam, lParam)
End Function