[RESOLVED] Copy file to clipboard with OleSetClipboard
Hi,
help me, please, with an implementation.
I have a crash.
Code:
Option Explicit
Private Declare Function OleSetClipboard Lib "ole32.dll" (ByVal pDataObj As Long) As Long
Private Declare Function OleFlushClipboard Lib "ole32.dll" () As Long
Private Sub Form_Load()
ClipboardCopyFile "c:\windows\system32\cmd.exe"
End Sub
Private Function ClipboardCopyFile(sFile As String) As Boolean
Dim pidlFile As Long
Dim pidlChild As Long
Dim psfParent As IShellFolder
Dim psData As IDataObject
pidlFile = ILCreateFromPathW(StrPtr(sFile))
If pidlFile <> 0 Then
Debug.Print SHBindToParent(pidlFile, IID_IShellFolder, psfParent, pidlChild)
If (psfParent Is Nothing) Or (pidlChild = 0) Then
Debug.Print "Failed to bind to parent of: " & sFile
Else
ReDim aPidl(0) As Long
aPidl(0) = pidlChild
Debug.Print psfParent.GetUIObjectOf(0&, 1&, VarPtr(aPidl(0)), IID_IDataObject, 0&, psData)
If (psData Is Nothing) Then
Debug.Print "Failed to get IDataObject interface for: " & sFile
Else
'crash
Debug.Print OleSetClipboard(VarPtr(psData))
Debug.Print OleFlushClipboard()
End If
End If
CoTaskMemFree pidlFile
End If
End Function
I know it can be accomplished with DROPFILES + SetClipboardData, but I do like to try the way with OleSetClipboard.
Re: [RESOLVED] Copy file to clipboard with OleSetClipboard
why cash?can you upload new zip project,thank you
Code:
Private Declare Function OleSetClipboard Lib "ole32.dll" (ByVal pDataObj As IDataObject) As Long
Private Declare Function OleFlushClipboard Lib "ole32.dll" () As Long
Private Sub Form_Load()
Clipboard.Clear
ClipboardCopyFile "C:\Windows\System32\regsvr32.exe"
'"c:\windows\system32\cmd.exe"
End Sub
Private Function ClipboardCopyFile(sFile As String) As Boolean
Dim pidlFile As Long
Dim pidlChild As Long
Dim psfParent As IShellFolder
Dim psData As IDataObject
pidlFile = ILCreateFromPathW(StrPtr(sFile))
If pidlFile <> 0 Then
Debug.Print SHBindToParent(pidlFile, IID_IShellFolder, psfParent, pidlChild)
If (psfParent Is Nothing) Or (pidlChild = 0) Then
Debug.Print "Failed to bind to parent of: " & sFile
Else
ReDim aPidl(0) As Long
aPidl(0) = pidlChild
Dim ptr As Long
Debug.Print psfParent.GetUIObjectOf(0&, 1&, VarPtr(aPidl(0)), IID_IDataObject, 0&, psData)
If (psData Is Nothing) Then
Debug.Print "Failed to get IDataObject interface for: " & sFile
Else
'crash
Call OleSetClipboard(psData)
Call OleFlushClipboard
End If
End If
MsgBox "ok"
CoTaskMemFree pidlFile
End If
End Function
Re: [RESOLVED] Copy file to clipboard with OleSetClipboard
Code:
Private Declare Function OleSetClipboard Lib "ole32.dll" (ByVal pDataObj As IDataObject) As Long
Private Declare Function OleFlushClipboard Lib "ole32.dll" () As Long
Private Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Sub Form_Load()
ClipboardCopyFile "c:\windows\system32\cmd.exe"
End Sub
Public Function ClipboardCopyFile(sFile As String) As Boolean
Dim pidlFile As Long
Dim pidlChild As Long
Dim psfParent As IShellFolder
Dim psData As IDataObject
'Dim Redirect As Boolean, bOldStatus As Boolean
'If Not FileExists(sFile) Then Exit Function
'Redirect = ToggleWow64FSRedirection(False, sFile, bOldStatus)
pidlFile = ILCreateFromPathW(StrPtr(sFile))
If pidlFile <> 0 Then
Call SHBindToParent(pidlFile, IID_IShellFolder, psfParent, pidlChild)
If (psfParent Is Nothing) Or (pidlChild = 0) Then
Debug.Print "Failed to bind to parent of: " & sFile
Else
ReDim aPidl(0) As Long
aPidl(0) = pidlChild
Call psfParent.GetUIObjectOf(0&, 1&, aPidl(0), IID_IDataObject, 0&, psData)
If (psData Is Nothing) Then
Debug.Print "Failed to get IDataObject interface for: " & sFile
Else
Call OleSetClipboard(psData)
Call OleFlushClipboard
End If
End If
CoTaskMemFree pidlFile
End If
'If Redirect Then Call ToggleWow64FSRedirection(bOldStatus)
End Function
+
Code:
Reference=*\G{F9015E81-CAAC-45C0-94E8-42B7DA5D7557}#4.5#0#oleexp.tlb#OLEEXP - olelib With Modern Interfaces by fafalone, v4.5