|
|
研究了好久，工作原因断断续续的查网页，到现在也没解决，实在受不了了。是这样的，我原来的一段复制文件到剪切板的代码，在32位系统运行没问题，但换到了64位 win10系统的笔记本后，就提示类型不匹配了
代码如下，红色字体是提示错误的部分：
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>> Author: Joforn <<<<<<<<<<<<<<<<<<
'>>>>>>>> Email: Joforn@sohu.com <<<<<<<<<<<<<<<<<<
'>>>>>>>> QQ: 42978116 <<<<<<<<<<<<<<<<<<
'>>>>>>>> Last time : 04/11/2012 <<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>\\\\\\\\\\\\\\\\\\\\\\\ API函数定义开始 /////////////////////////<
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32.dll" Alias "RegisterClipboardFormatW" (ByVal lpString As Long) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal flags As Long, ByVal size As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>\\\\\\\\\\\\\\\\\\\\\\\ API函数定义结束 /////////////////////////<
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Const CF_HDROP As Long = 15&
Private Const DROPEFFECT_COPY As Long = 1
Private Const DROPEFFECT_MOVE As Long = 2
Private Const GMEM_ZEROINIT As Long = &H40
Private Const GMEM_MOVEABLE As Long = &H2
Private Const GMEM_DDESHARE As Long = &H2000
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>\\\\\\\\\\\\\\\\\\\\\\\ 结构定义开始 /////////////////////////<
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type dropFiles
pFiles As Long
PT As POINTAPI
fNC As Long
fWide As Long
End Type
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'>\\\\\\\\\\\\\\\\\\\\\\\ 结构定义结束 ////////////////////////<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Public Function CutOrCopyFiles(FileList As Variant, Optional ByVal CopyMode As Boolean = True) As Boolean
Dim uDropEffect As Long, i As Long
Dim dropFiles As dropFiles
Dim uGblLen As Long, uDropFilesLen As Long
Dim hGblFiles As Long, hGblEffect As Long
Dim mPtr As Long
Dim FileNames As String
If OpenClipboard(0) Then
EmptyClipboard
FileNames = GetFileListString(FileList)
If Len(FileNames) Then
uDropEffect = RegisterClipboardFormat(StrPtr("Preferred DropEffect"))
' uDropEffect = RegisterClipboardFormat(("Preferred DropEffect"))
hGblEffect = GlobalAlloc(GMEM_ZEROINIT Or GMEM_MOVEABLE Or GMEM_DDESHARE, Len(uDropEffect))
mPtr = GlobalLock(hGblEffect)
i = IIf(CopyMode, DROPEFFECT_COPY, DROPEFFECT_MOVE)
CopyMemory ByVal mPtr, i, Len(i)
GlobalUnlock hGblEffect
uDropFilesLen = Len(dropFiles)
With dropFiles
.pFiles = uDropFilesLen
.fWide = CLng(True)
End With
uGblLen = uDropFilesLen + Len(FileNames) * 2 + 8
hGblFiles = GlobalAlloc(GMEM_ZEROINIT Or GMEM_MOVEABLE Or GMEM_DDESHARE, uGblLen)
mPtr = GlobalLock(hGblFiles)
CopyMemory ByVal mPtr, dropFiles, uDropFilesLen
CopyMemory ByVal (mPtr + uDropFilesLen), ByVal StrPtr(FileNames), LenB(FileNames)
GlobalUnlock hGblFiles
SetClipboardData CF_HDROP, hGblFiles
End If
CloseClipboard
End If
End Function
Private Function GetFileListString(FileList As Variant) As String
Dim i As Long
On Error GoTo GetFileListStringLOOP
Select Case VarType(FileList)
Case vbString
GetFileListString = Trim$(FileList)
Case &H2008
For i = LBound(FileList) To UBound(FileList)
FileList(i) = Trim$(FileList(i))
If Len(FileList(i)) Then GetFileListString = GetFileListString & FileList(i) & vbNullChar
Next i
If Len(GetFileListString) Then GetFileListString = left$(GetFileListString, Len(GetFileListString) - 1)
End Select
GetFileListStringLOOP:
End Function
提示错误截图：
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2021-3-24 00:50
楼主
发表于 2021-4-2 11:57
