请问如何监控获得用户拷贝网页内容的HTML代码以及拷贝的文件和图形啊？
如题！ 问题点数：100、回复次数：2Top
1 楼TechnoFantasy（（VB MVP）www.applevb.com）回复于 2006-07-03 17:46:09 得分 100
手头正好有一个这样的代码，你在工程的Form1中加入一个ListBox，一个TextBox以及一个PictureBox和一个CommandButton，然后再加入一个模块。在模块中加入以下代码：
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 CF_DIB = 8
Const CF_BITMAP = 2
Const MAX_PATH As Long = 260
Private Const m_sDescription = _
"Version:1.0" & vbCrLf & _
"StartHTML:aaaaaaaaaa" & vbCrLf & _
"EndHTML:bbbbbbbbbb" & vbCrLf & _
"StartFragment:cccccccccc" & vbCrLf & _
"EndFragment:dddddddddd" & vbCrLf
Private m_cfHTMLClipFormat As Long
Function RegisterCF() As Long
'Register the HTML clipboard format
If (m_cfHTMLClipFormat = 0) Then
m_cfHTMLClipFormat = RegisterClipboardFormat("HTML Format")
End If
RegisterCF = m_cfHTMLClipFormat
End Function
Public Sub PutHTMLClipboard(sHtmlFragment As String, _
Optional sContextStart As String = "<HTML><BODY>", _
Optional sContextEnd As String = "</BODY></HTML>")
Dim sData As String
If RegisterCF = 0 Then Exit Sub
'Add the starting and ending tags for the HTML fragment
sContextStart = sContextStart & "<!--StartFragment -->"
sContextEnd = "<!--EndFragment -->" & sContextEnd
'Build the HTML given the description, the fragment and the context.
'And, replace the offset place holders in the description with values
'for the offsets of StartHMTL, EndHTML, StartFragment and EndFragment.
sData = m_sDescription & sContextStart & sHtmlFragment & sContextEnd
sData = Replace(sData, "aaaaaaaaaa", _
Format(Len(m_sDescription), "0000000000"))
sData = Replace(sData, "bbbbbbbbbb", Format(Len(sData), "0000000000"))
sData = Replace(sData, "cccccccccc", Format(Len(m_sDescription & _
sContextStart), "0000000000"))
sData = Replace(sData, "dddddddddd", Format(Len(m_sDescription & _
sContextStart & sHtmlFragment), "0000000000"))
'Add the HTML code to the clipboard
If CBool(OpenClipboard(0)) Then
Dim hMemHandle As Long, lpData As Long
hMemHandle = GlobalAlloc(0, Len(sData) + 10)
If CBool(hMemHandle) Then
lpData = GlobalLock(hMemHandle)
If lpData <> 0 Then
CopyMemory ByVal lpData, ByVal sData, Len(sData)
GlobalUnlock hMemHandle
EmptyClipboard
SetClipboardData m_cfHTMLClipFormat, hMemHandle
End If
End If
Call CloseClipboard
End If
End SubTop
2 楼TechnoFantasy（（VB MVP）www.applevb.com）回复于 2006-07-03 17:46:26 得分 0
Public Function GetHTMLClipboard() As String
Dim sData As String
If RegisterCF = 0 Then Exit Function
If CBool(OpenClipboard(0)) Then
Dim hMemHandle As Long, lpData As Long
Dim nClipSize As Long
GlobalUnlock hMemHandle
'Retrieve the data from the clipboard
hMemHandle = GetClipboardData(m_cfHTMLClipFormat)
If CBool(hMemHandle) Then
lpData = GlobalLock(hMemHandle)
If lpData <> 0 Then
nClipSize = lstrlen(lpData)
sData = String(nClipSize + 10, 0)
'Copy the html data to a string
Call CopyMemory(ByVal sData, ByVal lpData, nClipSize)
Dim nStartFrag As Long, nEndFrag As Long
Dim nIndx As Long
'If StartFragment appears in the data's description,
'then retrieve the offset specified in the description
'for the start of the fragment. Likewise, if EndFragment
'appears in the description, then retrieve the
'corresponding offset.
nIndx = InStr(sData, "StartFragment:")
If nIndx Then
nStartFrag = CLng(Mid(sData, _
nIndx + Len("StartFragment:"), 10))
End If
nIndx = InStr(sData, "EndFragment:")
If nIndx Then
nEndFrag = CLng(Mid(sData, nIndx + Len("EndFragment:"), 10))
End If
'Return the fragment given the starting and ending
'offsets
If (nStartFrag > 0 And nEndFrag > 0) Then
GetHTMLClipboard = Mid(sData, nStartFrag + 1, _
(nEndFrag - nStartFrag))
End If
End If
End If
Call CloseClipboard
End If
End Function
Public Sub HookForm(F As Form)
'Set the window procedure handler and return prev window procedure handler
PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHookForm(F As Form)
'set the prev window procedure handler
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)
'Get count of files
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
'Retrieves the names of copied files
Call DragQueryFile(hDrop, i, filename, Len(filename))
Files(i) = TrimNull(filename)
strAllFile = strAllFile + Files(i)
strAllFile = strAllFile + "|"
Next i
'return the copied files
GetFileClipboard = strAllFile
Call CloseClipboard
End If
End Function
Sub GetClipboardPicture(Format As Long, pic As PictureBox)
On Error Resume Next
'Set the copied image to a picture object
pic.Picture = Clipboard.GetData(Format)
End Sub
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
If (IsClipboardFormatAvailable(CF_HDROP)) Then
Dim s() As String
Dim i As Integer
Form1.List1.Clear
s = Split(GetFileClipboard, "|")
For i = LBound(s) To UBound(s)
Form1.List1.AddItem (s(i))
Next i
End If
Form1.Text1.Text = GetHTMLClipboard
If (IsClipboardFormatAvailable(CF_BITMAP)) Then
Call GetClipboardPicture(CF_BITMAP, Form1.Picture1)
End If
If (IsClipboardFormatAvailable(CF_DIB)) Then
Call GetClipboardPicture(CF_DIB, Form1.Picture1)
End If
End If
End Function
然后在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
运行程序，当拷贝文件后，文件就会在ListBox1中显示，拷贝的HTML会在TextBox1中显示，拷贝的图片会在PictureBox1中显示，记得要把PictureBox1的AutoRedraw属性设置为True。Top
