仅供参考，尽管是VB6：
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "ShowFilesOnClipboard - Double-click to refresh."
ClientHeight = 3135
ClientLeft = 45
ClientTop = 330
ClientWidth = 7560
Icon = "ShowFilesOnClipboard.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3135
ScaleWidth = 7560
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox Text1
Height = 2895
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 0
Text = "ShowFilesOnClipboard.frx":030A
Top = 120
Width = 7335
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const CF_HDROP = 15
Private Type POINT
x As Long
y As Long
End Type
Private Type DROPFILES
pFiles As Long
pt As POINT
fNC As Long
fWide As Long
End Type
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Sub ShowFilesOnClipboard()
Dim lHandle As Long
Dim lpResults As Long
Dim lRet As Long
Dim df As DROPFILES
Dim strDest As String
Dim lBufferSize As Long
Dim arBuffer() As Byte
Dim vNames As Variant
Dim i As Long
Dim txt As String
Dim fn As String
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
If OpenClipboard(0) Then
lHandle = GetClipboardData(CF_HDROP)
' If you don't find a CF_HDROP, you don't want to process anything
If lHandle > 0 Then
lpResults = GlobalLock(lHandle)
lBufferSize = GlobalSize(lpResults)
ReDim arBuffer(0 To lBufferSize)
CopyMemory df, ByVal lpResults, Len(df)
Call CopyMemory(arBuffer(0), ByVal lpResults + df.pFiles, (lBufferSize - Len(df)))
If df.fWide = 1 Then
' it is wide chars--unicode
strDest = arBuffer
Else
strDest = StrConv(arBuffer, vbUnicode)
End If
GlobalUnlock lHandle
vNames = Split(strDest, vbNullChar)
i = 0
txt = ""
Do
fn = vNames(i)
If Len(fn) <= 0 Then Exit Do
If fs.FolderExists(fn) Then fn = fn + "\"
If InStr(fn, " ") > 0 Then
txt = txt + Chr(34) + fn + Chr(34) + vbCrLf
Else
txt = txt + fn + vbCrLf
End If
i = i + 1
Loop
Else
txt = "No files on clipboard. Double-click to refresh."
End If
Else
txt = "Can not open clipboard. Double-click to retry."
End If
CloseClipboard
Set fs = Nothing
Text1.Text = txt
End Sub
Private Sub Form_DblClick()
Call ShowFilesOnClipboard
End Sub
Private Sub Form_Load()
Call ShowFilesOnClipboard
End Sub
Private Sub Text1_DblClick()
Call ShowFilesOnClipboard
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 1 Then 'ctrl a
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
ElseIf KeyAscii = 3 Then 'ctrl c
Text1.SelLength = 0
Clipboard.SetText Text1.Text
End If
End Sub
本版专家分：2结帖率 100%
本版专家分：5382
本版专家分：378175
