将长路径转为短路径
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String,ByVal lpszShortPath As String,ByVal cchBuffer As Long) As Long
Private Function ShortPath(ByVal FileName As String) As String
Dim S As String
On Error GoTo exitFunc:
S = String(255," ")
GetShortPathName FileName,S,255
ShortPath = Left(S,InStr(S,Chr(0)) - 1)
exitFunc:
End Function
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)
Public mvarfilelist As String
Public Function ShowFilesOnClipboard() As String 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 ShowFilesOnClipboard = "" 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 ShowFilesOnClipboard = ShowFilesOnClipboard & "<img src='file:///" & ShortPath(vNames(i)) & "'><br>" i = i + 1 Wend End If End If CloseClipboard End Function
原文链接:/vb/262153.html