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