Tác giả: Sưu tầm
Mô tả: Giám sát clipboard copy
Form:
- Option Explicit
- Private Sub Form_Load()
- If clipboard_is_hooked = False Then
- clipboard_is_hooked = hook_clipboard(Me.hWnd)
- End If
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- If clipboard_is_hooked = True Then
- clipboard_is_hooked = unhook_clipboard(Me.hWnd)
- End If
- End Sub
- Private Sub Form_Activate()
- Text1.SetFocus
- End Sub
- Private Sub btnExit_Click()
- Unload Me
- End Sub
- Private Sub btnClear_Click()
- Text1.Text = ""
- End Sub
- Private Sub Text1_Change()
- 'whenever text in the textbox is changed, move the cursor to the end of the text
- Text1.SelStart = Len(Text1.Text)
- End Sub
- Private Sub Text1_GotFocus()
- 'whenever the textbox gains focus, move the cursor to the end of the text
- Text1.SelStart = Len(Text1.Text)
- End Sub
- 'Copy above text into clipboard
- Private Sub btnCopy_Click()
- If clipboard_is_hooked = True Then
- clipboard_is_hooked = unhook_clipboard(Me.hWnd)
- End If
- Clipboard.Clear
- Clipboard.SetText Text1.Text
- If clipboard_is_hooked = False Then
- Text1.Text = ""
- clipboard_is_hooked = hook_clipboard(Me.hWnd)
- End If
- End Sub
- Private Sub Form_Resize()
- If Me.Width > Label1.Width Then
- Label1.Left = (Me.Width - Label1.Width) / 2
- End If
- If Me.Width > 420 Then
- Text1.Width = Me.Width - 420
- End If
- If Me.Width > Text1.Width Then
- Text1.Left = (Me.Width - Text1.Width) / 2
- End If
- If Me.Height > 2040 Then
- Text1.Height = Me.Height - 2040
- Text1.Top = 720
- End If
- If Me.Height > 1165 Then
- btnClear.Top = Me.Height - 1165
- btnCopy.Top = Me.Height - 1165
- btnExit.Top = Me.Height - 1165
- End If
- btnClear.Left = Text1.Left + 60
- If Me.Width > (250 + btnExit.Width) Then
- btnExit.Left = Me.Width - 250 - btnExit.Width
- End If
- If Me.Width > btnCopy.Width Then
- btnCopy.Left = ((Me.Width - btnCopy.Width) / 2) + (0.002 * Me.Width)
- End If
- End Sub
Module:
- 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