高分求助大虾

ljwfriends 2006-05-03 05:41:18
高分求助大虾,现在小弟想写个这样的程序,后台监测用户对文件的复制,粘贴两个操作,并且记录被复制粘贴文件的文件名,路径,时间!
小弟先谢了
...全文
212 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
Arqui 2006-05-11
  • 打赏
  • 举报
回复
好长的代码
randomx 2006-05-09
  • 打赏
  • 举报
回复
干吗?
DawnPine 2006-05-09
  • 打赏
  • 举报
回复
先顶再看!
TechnoFantasy 2006-05-03
  • 打赏
  • 举报
回复
创建新工程。
首先在Form1添加以下代码:


Private Sub Form_Load()
'Subclass this form
HookForm Me
'Register this form as a Clipboardviewer
SetClipboardViewer Me.hwnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Unhook the form
UnHookForm Me
End Sub


然后在工程中添加一个模块,在其中加入以下代码:
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
Declare Function SetClipboardViewer Lib "user32" (ByVal hwnd As Long) As Long
Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) _
As Long
Declare Function GlobalAlloc Lib "kernel32" ( _
ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function SetClipboardData Lib "user32" ( _
ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function RegisterClipboardFormat Lib "user32" Alias _
"RegisterClipboardFormatA" (ByVal lpString As String) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
As Long
Declare Function GlobalUnlock Lib "kernel32" ( _
ByVal hMem As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
pDest As Any, pSource As Any, ByVal cbLength As Long)
Declare Function GetClipboardData Lib "user32" ( _
ByVal wFormat As Long) As Long
Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" ( _
ByVal lpData As Long) As Long
Declare Function DragQueryFile Lib "shell32.dll" Alias _
"DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, _
ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare Function DragQueryPoint Lib "shell32.dll" (ByVal _
hDrop As Long, lpPoint As POINTAPI) As Long

Public Const WM_DRAWCLIPBOARD = &H308
Public Const GWL_WNDPROC = (-4)
Dim PrevProc As Long
Const CF_HDROP = 15
Const MAX_PATH As Long = 260

Public Sub HookForm(F As Form)
PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHookForm(F As Form)
SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc
End Sub
Private Function TrimNull(ByVal StrIn As String) As String
Dim nul As Long
nul = InStr(StrIn, vbNullChar)
Select Case nul
Case Is > 1
TrimNull = Left(StrIn, nul - 1)
Case 1
TrimNull = ""
Case 0
TrimNull = Trim(StrIn)
End Select
End Function

Public Function GetFileClipboard() As String
Dim sData As String
Dim hDrop As Long
Dim nFiles As Long
Dim i As Long
Dim desc As String
Dim filename As String
Dim pt As POINTAPI
Dim tfStr As SHFILEOPSTRUCT
Dim Files() As String

If CBool(OpenClipboard(0)) Then

Dim hMemHandle As Long, lpData As Long
Dim nClipSize As Long


hDrop = GetClipboardData(CF_HDROP)
'获得文件数
nFiles = DragQueryFile(hDrop, -1&, "", 0)

ReDim Files(0 To nFiles - 1) As String

Dim strAllFile As String

filename = Space(MAX_PATH)
For i = 0 To nFiles - 1
'根据获取的每一个文件执行文件拷贝操作
Call DragQueryFile(hDrop, i, filename, Len(filename))
Files(i) = TrimNull(filename)

strAllFile = strAllFile + Files(i)
strAllFile = strAllFile + "|"
Next i

GetFileClipboard = strAllFile
Call CloseClipboard
End If

End Function

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
If uMsg = WM_DRAWCLIPBOARD Then
'MsgBox "Clipboard changed ..."

If (IsClipboardFormatAvailable(CF_HDROP)) Then
Debug.Print GetFileClipboard
End If
End If
End Function

然后运行,拷贝两个文件,然后在Debug窗口中就可以列出拷贝的文件了,文件用|分割。拷贝的时间就是当前时间。

2,506

社区成员

发帖
与我相关
我的任务
社区描述
VBA(Visual Basic for Applications)是Visual Basic的一种宏语言,是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。
社区管理员
  • VBA
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧