Copy file to clipboard and use API functions in VB.NET (#1)
-
Imports Scripting
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.IO.File
Module MdlClipboard
Public Structure POINTAPI
Public x As Integer
Public y As Integer
End Structure
Public Structure DROPFILES
Public pFiles As Integer
Public pt As POINTAPI
Public fNC As Integer
Public fWide As Integer
End Structure
#Region "Predefined Clipboard Formats"
Private Const CFTEXT As Integer = 1
Private Const CFBITMAP As Integer = 2
Private Const CFMETAFILEPICT As Integer = 3
Private Const CFSYLK As Integer = 4
Private Const CFDIF As Integer = 5
Private Const CFTIFF As Integer = 6
Private Const CFOEMTEXT As Integer = 7
Private Const CFDIB As Integer = 8
Private Const CFPALETTE As Integer = 9
Private Const CFPENDATA As Integer = 10
Private Const CFRIFF As Integer = 11
Private Const CFWAVE As Integer = 12
Private Const CFUNICODETEXT As Integer = 13
Private Const CFENHMETAFILE As Integer = 14
Private Const CFHDROP As Integer = 15
Private Const CFLOCALE As Integer = 16
Private Const CFMAX As Integer = 17
' New shell-oriented clipboard formats
Private Const CFSTRSHELLIDLIST As String = "Shell IDList Array"
Private Const CFSTRSHELLIDLISTOFFSET As String = "Shell Object Offsets"
Private Const CFSTRNETRESOURCES As String = "Net Resource"
Private Const CFSTRFILEDESCRIPTOR As String = "FileGroupDescriptor"
Private Const CFSTRFILECONTENTS As String = "FileContents"
Private Const CFSTRFILENAME As String = "FileName"
Private Const CFSTRPRINTERGROUP As String = "PrinterFriendlyName"
Private Const CFSTRFILENAMEMAP As String = "FileNameMap"
' Global Memory Flags
Private Const GMEMFIXED = &H0
Private Const GMEMMOVEABLE As Integer = &H2
Private Const GMEMZEROINIT As Integer = &H40
Private Const GMEMDDESHARE As Integer = &H2000
Private Const GMEMNOCOMPACT As Integer = &H10
Private Const GMEMNODISCARD As Integer = &H20
Private Const GMEMMODIFY As Integer = &H80
Private Const GMEMDISCARDABLE As Integer = &H100
Private Const GMEMNOTBANKED As Integer = &H1000
Private Const GMEMSHARE As Integer = &H2000
Private Const GMEMNOTIFY As Integer = &H4000
Private Const GMEMLOWER As Integer = GMEMNOTBANKED
Private Const GMEMVALIDFLAGS As Integer = &H7F72
Private Const GMEMINVALIDHANDLE As Integer = &H8000
Private Const GHND As Integer = (GMEMMOVEABLE Or GMEMZEROINIT)
Private Const GPTR As Integer = (GMEMFIXED Or GMEMZEROINIT)
#End Region
#Region "Clipboard Manager Functions"
'Public Declare Function EmptyClipboard Lib "user32" () As Integer
'Public Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Integer) As Integer
'Public Declare Function CloseClipboard Lib "user32" () As Integer
'Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Integer, ByVal hMem As Integer) As Integer
'Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Integer
'Public Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Integer
<DllImport("user32", CharSet:=CharSet.Ansi)>
Public Function EmptyClipboard() As Integer
End Function
<DllImport("user32", CharSet:=CharSet.Ansi)> _
Public Function OpenClipboard(ByVal hWnd As Integer) As Integer
End Function
<DllImport("user32", CharSet:=CharSet.Ansi)> _
Public Function CloseClipboard() As Integer
End Function
<DllImport("user32", CharSet:=CharSet.Ansi)> _
Public Function SetClipboardData(ByVal wFormat As Integer, ByVal hMem As Integer) As Integer
End Function
<DllImport("user32", CharSet:=CharSet.Ansi)> _
Public Function GetClipboardData(ByVal wFormat As Integer) As Integer
End Function
<DllImport("user32", CharSet:=CharSet.Ansi)> _
Public Function IsClipboardFormatAvailable(ByVal wFormat As Integer) As Integer
End Function
#End Region
#Region "Other required Win32 APIs"
'Public Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Integer, ByVal UINT As Integer, ByVal lpStr As String, ByVal ch As Integer) As Integer
'Public Declare Function DragQueryPoint Lib "shell32.dll" (ByVal hDrop As Integer, ByVal lpPoint As POINTAPI) As Integer
'Public Declare Sub DragFinish Lib "shell32.dll" (ByVal hDrop As Integer)
'Public Declare Sub DragFinish Lib "shell32.dll" (ByVal hDrop As Integer)
'Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Integer, ByVal dwBytes As Integer) As Integer
'Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Integer) As Integer
'Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Integer) As Integer
'Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Integer) As Integer
'Public Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Integer, ByVal Source As Integer, ByVal Length As Integer)
'Public Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Integer, ByVal Source As String, ByVal Length As Integer)
'Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Integer, ByVal Source As Integer, ByVal Length As Integer)
<DllImport("shell32.dll", CharSet:=CharSet.Ansi)> _
Public Function DragQueryFile(ByVal hDrop As Integer, ByVal UINT As Integer, ByVal lpStr As String, ByVal ch As Integer) As Integer
End Function
<DllImport("shell32.dll", CharSet:=CharSet.Ansi)> _
Public Function DragQueryPoint(ByVal hDrop As Integer, ByVal lpPoint As POINTAPI) As Integer
End Function
<DllImport("shell32.dll", CharSet:=CharSet.Ansi)> _
Public Sub DragFinish(ByVal hDrop As Integer)
End Sub
<DllImport("kernel32", CharSet:=CharSet.Ansi)> _
Public Function GlobalAlloc(ByVal wFlags As Integer, ByVal dwBytes As Integer) As Integer
End Function
<DllImport("kernel32", CharSet:=CharSet.Ansi)> _
Public Function GlobalFree(ByVal hMem As Integer) As Integer
End Function
<DllImport("kernel32", CharSet:=CharSet.Ansi)> _
Public Function GlobalLock(ByVal hMem As Integer) As Integer
End Function
<DllImport("kernel32", CharSet:=CharSet.Ansi)> _
Public Function GlobalUnlock(ByVal hMem As Integer) As Integer
End Function
<DllImport("kernel32", CharSet:=CharSet.Ansi)> _
Public Sub MoveMemory(ByVal Destination As Integer, ByVal Source As Integer, ByVal Length As Integer)
End Sub
<DllImport("kernel32.dll", CharSet:=CharSet.Ansi)> _
Public Overloads Sub CopyMemory(ByVal Destination As Integer, ByVal Source As Integer, ByVal Length As Integer)
End Sub
<DllImport("kernel32.dll", CharSet:=CharSet.Ansi)> _
Public Overloads Sub CopyMemory(ByVal Destination As Integer, ByVal Source As String, ByVal Length As Integer)
End Sub
#End Region
Private Function TrimNull(ByVal sTmp As String) As String
Dim nNul As Long
nNul = InStr(sTmp, vbNullChar)
Select Case nNul
Case Is > 1
TrimNull = Left(sTmp, nNul - 1)
Case 1
TrimNull = ""
Case 0
TrimNull = Trim(sTmp)
End Select
End Function
Private Function AddSlash(ByVal strPath As String) As String
If Right(Trim(strPath), 1) <> "\" Then
strPath = Trim(strPath) & "\"
End If
AddSlash = strPath
End Function
Private Function VarPtr(ByVal pObject As Object) As Integer
Dim GC As GCHandle
Dim ret As Integer
GC = GCHandle.Alloc(pObject, GCHandleType.Pinned)
ret = GC.AddrOfPinnedObject.ToInt32
GC.Free()
Return ret
End Function
'// Explain to perform
'// http://www.codeguru.com/cpp/w-p/clipboard/article.php/c2997/
'// The clue I got was that, there is a DROPFILES structure in shlobj.h. However, there is no documentation on how to use it. Actually, it is the structure, whose pointer is the one we are receiving as HDROP handle. That is the mystery.
'// Just debug HDROP value before calling DragQueryFile function. It always says, 20. It is so because the DROPFILES structure's first member is the offset where the files are placed. Because the files are always attached to the end of the structure, the 20 is the size of the DROPFILES structure.
'// One important issue is that, the DROPFILES's last parameter specifies whether the appended string is a Multi/Single Byte character string. Windows NT uses Multi byte Character set. To suit to this requirement, we will also use Multi Byte character format for the appended file names.
'//
'// So, do the following steps to get the job done.
'// 1. First, prepare a string of null separated file names and pad with an extra null. The extra null is the requirement to indicate the end of file names.
'// 2. Next, prepare a HGLOBAL of size equal to the sum of length of string of the file names and the size of the DROPFILES. Account for NULLs in between and at the end.
'// The HGLOBAL should be created with these flags: GMEMZEROINIT|GMEMMOVEABLE|GMEMDDESHARE
'// 3. Lock the HGLOBAL to get a memory pointer. Fill up the first 20 bytes memory with the DROPFILES structure values.
'// 4. Copy the file names to the rest of the memory. Once copying is done, unlock the HGLOBAL.
'// 5. Open the clipboard, empty it and do SetClipboardData with CFHDROP format and your HGLOBAL.
'// 6. Close the clipboard, but don't free the HGLOBAL.
'// 7. That's it. Your job is done.
'---------------------------------------------------------------------------------------------------------------------------------
'//
'// Source code: http://www.developerfusion.co.uk/show/224/
'// Copy file to clipboard
'//
'---------------------------------------------------------------------------------------------------------------------------------
Public Function ClipboardCopyFiles(ByVal Files() As String) As Integer
Dim data As String
Dim df As DROPFILES
Dim hGlobal As Integer
Dim lpGlobal As Integer
Dim iIntPtr As Integer
Dim iStrPtr As Integer
Dim sizeOfDF As Integer
Dim idxFile As Integer
Dim scriptingFile As Scripting.File
Dim fileSysObject As New Scripting.FileSystemObject
Try
'// Open and clear existing crud off clipboard.
If OpenClipboard(0&) Then
Call EmptyClipboard()
'// Build double-null terminated list of files.
For idxFile = LBound(Files) To UBound(Files) - 1
If Not (Files(idxFile) Is Nothing) Then
scriptingFile = fileSysObject.GetFile(Files(idxFile).ToString())
data = scriptingFile.ShortPath & vbNullChar
End If
Next
'// Allocate and get pointer to global memory, then copy file list to it.
data = data & vbNullChar
' Allocate and get pointer to global memory, then copy file list to it.
sizeOfDF = Len(df)
hGlobal = GlobalAlloc(GHND, sizeOfDF + Len(data))
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)
' Build DROPFILES structure in global memory.
df.pFiles = sizeOfDF
iIntPtr = VarPtr(df)
Call CopyMemory(lpGlobal, iIntPtr, sizeOfDF)
sizeOfDF = Len(df)
iStrPtr = VarPtr(data)
Call CopyMemory((lpGlobal + sizeOfDF), data, Len(data))
Call GlobalUnlock(hGlobal)
' Copy data to clipboard, and return success.
If SetClipboardData(CFHDROP, hGlobal) Then
ClipboardCopyFiles = hGlobal
End If
End If
' Clean up
Call CloseClipboard()
End If
Catch ex As Exception
MsgBox(ex.Source & " : " + ex.Message)
ClipboardCopyFiles = 0
End Try
End Function
Public Function ClipboardPasteFiles(ByVal Files() As String) As Long
Dim hDrop As Long
Dim nFiles As Long
Dim i As Long
Dim desc As String
Dim filename As String
Dim pt As POINTAPI
Const MAXPATH As Long = 260
' Insure desired format is there, and open clipboard.
If IsClipboardFormatAvailable(CFHDROP) Then
If OpenClipboard(0&) Then
' Get handle to Dropped Filelist data, and number of files.
hDrop = GetClipboardData(CFHDROP)
nFiles = DragQueryFile(hDrop, -1&, "", 0)
' Allocate space for return and working variables.
'ReDim Files( 0 To nFiles - 1) As String
ReDim Files(nFiles - 1)
filename = Space(MAXPATH)
' Retrieve each filename in Dropped Filelist.
For i = 0 To nFiles - 1
Call DragQueryFile(hDrop, i, filename, Len(filename))
Files(i) = TrimNull(filename)
Next
' Clean up
DragFinish(hDrop)
Call CloseClipboard()
End If
' Assign return value equal to number of files dropped.
ClipboardPasteFiles = nFiles
End If
End Function
Public Sub FreeClipBoard(ByVal hMem As Integer)
Dim lpGlobal As Integer
lpGlobal = GlobalLock(hMem)
Call GlobalFree(lpGlobal)
End Sub
End Module '// End Of Module
Post a reply
Quick links
Recent activity
- arif ahmad replied to How to receive data in web ...
- William Thompson replied to What is the name of the Win...
- Sameera Piyadigamage replied to Point of Sale Developers: H...
- Scott Carline replied to 4 x C# Developers for large...
- Rajendra Dhakal replied to Restore SQL Server text dat...
- cloud rainda replied to How to convert between TS f...
No one has replied yet! Why not be the first?
Sign in or Join us (it's free).