form1.frm

这是一本学习 window编程的很好的参考教材

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5595
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5715
   LinkTopic       =   "Form1"
   ScaleHeight     =   5595
   ScaleWidth      =   5715
   StartUpPosition =   3  'Windows Default
   Begin VB.ListBox List1 
      Height          =   5130
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   3975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "获取文件"
      Height          =   495
      Left            =   4320
      TabIndex        =   0
      Top             =   1080
      Width           =   1215
   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

   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
         While Len(vNames(i)) > 0
            List1.AddItem vNames(i)
            i = i + 1
         Wend
      End If
   End If
   CloseClipboard
End Sub

Private Sub Command1_Click()
   Call ShowFilesOnClipboard
End Sub