Copy file to clipboard and use API functions in VB.NET (#1)

• • Reply

  14 years ago

  by alpha24

  SON TRAN

  , Viet Nam

  Joined 14 years ago

  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
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  
  

  Report abuse