Question

请求VB高手帮忙，编个很小的程序，谢谢，好的追加！！

剪贴板变化后直接复制剪贴板内容为txt文件，并保存在D盘。其实是我想大量复制东西，一次一次保存太麻烦。要是能监控鼠标，鼠标一选定就直接保存为文件就更好了。。。分数翻三倍

有个监控剪贴板的，看不懂。。。http://school.cfan.com.cn/pro/vb/2006-08-28/1156737059d14498.shtml，如果你闲打字麻烦可以直接复制，十分感谢，本人初学。。。

Answer 1

Public lpPrevWndProc As Long
Public lClipboardChain As Long
Public Const GWL_WNDPROC = -4
Public Const WM_DRAWCLIPBOARD = &H308
Public Const WM_CHANGECBCHAIN = &H30D
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 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 Sub Hook(hwnd As Long)
' 在这里使用了 AddressOf，得到的是WindowProc 函数的地址
'GWL_WNDPROC告诉SetWindowLong 函数将使用SubClass
lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
'SubClass需要保存调用时返回的指针以便做其他处理
lClipboardChain = SetClipboardViewer(hwnd) '<1>
End Sub
Public Sub UnHook(hwnd As Long)
SetWindowLong hwnd, GWL_WNDPROC, lpPrevWndProc
ChangeClipboardChain hwnd, lClipboardChain '<2>
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 '<3>
'剪贴板改变时你要做什么处理就是写在这里了
Dim x As Integer
x = MsgBox("新建?", vbYesNo)
If x = vbYes Then
strp = InputBox("输入欲保存位置")
If Dir(strp) <> "" Then
Open strp For Append As #1
Print #1, Clipboard.GetText
Close #1
End If
Else
Open "d:\test.txt" For Append As #1
Print #1, Clipboard.GetText
Close #1
End If
Case WM_CHANGECBCHAIN
If lClipboardChain = wParam Then '<4>
lClipboardChain = lParam
End If
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam) '<5>
End Select
End Function

窗体代码：
Private Sub Form_Load()
Hook Me.hwnd
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
UnHook Me.hwnd
End Sub

内容保存在d:\test.txt

Answer 2

留个记号，观望