| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152 |
- Imports System
- Imports System.ComponentModel
- Imports System.Runtime.InteropServices
- Imports System.Text
- Imports System.Windows.Interop
- Public Class DragFileHelper
- Public Event DragDrop As EventHandler
- Public Property DropFilePaths As String()
- Get
- Return _DropFilePathsBackingField
- End Get
- Private Set(value As String())
- _DropFilePathsBackingField = value
- End Set
- End Property
- Private _DropFilePathsBackingField As String()
- Public Property DropPoint As POINT
- Get
- Return _DropPointBackingField
- End Get
- Private Set(value As POINT)
- _DropPointBackingField = value
- End Set
- End Property
- Private _DropPointBackingField As POINT
- Public Property HwndIntPtrSource As HwndSource
- Public Sub AddHook()
- Me.RemoveDragHook()
- Me.HwndIntPtrSource.AddHook(AddressOf WndProc)
- Dim handle As IntPtr = Me.HwndIntPtrSource.Handle
- If IsUserAnAdmin() Then RevokeDragDrop(handle)
- DragAcceptFiles(handle, True)
- ChangeMessageFilter(handle)
- End Sub
- Public Sub RemoveDragHook()
- Me.HwndIntPtrSource.RemoveHook(AddressOf WndProc)
- DragAcceptFiles(Me.HwndIntPtrSource.Handle, False)
- End Sub
- Private Function WndProc(ByVal hwnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr, ByRef handled As Boolean) As IntPtr
- Dim filePaths As String() = Nothing
- Dim point As POINT = New POINT()
- If TryGetDropInfo(msg, wParam, filePaths, point) Then
- DropPoint = point
- DropFilePaths = filePaths
- RaiseEvent DragDrop(Me, EventArgs.Empty)
- handled = True
- End If
- Return IntPtr.Zero
- End Function
- <DllImport("user32.dll", SetLastError:=True)>
- Private Shared Function ChangeWindowMessageFilterEx(ByVal hWnd As IntPtr, ByVal msg As UInteger, ByVal action As UInteger, ByRef pChangeFilterStruct As CHANGEFILTERSTRUCT) As Boolean
- End Function
- <DllImport("user32.dll", SetLastError:=True)>
- Private Shared Function ChangeWindowMessageFilter(ByVal msg As UInteger, ByVal flags As UInteger) As Boolean
- End Function
- <DllImport("shell32.dll")>
- Private Shared Sub DragAcceptFiles(ByVal hWnd As IntPtr, ByVal fAccept As Boolean)
- End Sub
- <DllImport("shell32.dll", CharSet:=CharSet.Unicode)>
- Private Shared Function DragQueryFile(ByVal hWnd As IntPtr, ByVal iFile As UInteger, ByVal lpszFile As StringBuilder, ByVal cch As Integer) As UInteger
- End Function
- <DllImport("shell32.dll")>
- Private Shared Function DragQueryPoint(ByVal hDrop As IntPtr, ByRef lppt As POINT) As Boolean
- End Function
- <DllImport("shell32.dll")>
- Private Shared Sub DragFinish(ByVal hDrop As IntPtr)
- End Sub
- <DllImport("ole32.dll")>
- Private Shared Function RevokeDragDrop(ByVal hWnd As IntPtr) As Integer
- End Function
- <DllImport("shell32.dll")>
- Private Shared Function IsUserAnAdmin() As Boolean
- End Function
- <StructLayout(LayoutKind.Sequential)>
- Public Structure POINT
- Public X As Integer
- Public Y As Integer
- End Structure
- <StructLayout(LayoutKind.Sequential)>
- Private Structure CHANGEFILTERSTRUCT
- Public cbSize As UInteger
- Public ExtStatus As UInteger
- End Structure
- Private Const WM_COPYGLOBALDATA As UInteger = &H49
- Private Const WM_COPYDATA As UInteger = &H4A
- Private Const WM_DROPFILES As UInteger = &H233
- Private Const MSGFLT_ALLOW As UInteger = 1
- Private Const MSGFLT_ADD As UInteger = 1
- Private Const MAX_PATH As Integer = 260
- Private Shared Sub ChangeMessageFilter(ByVal handle As IntPtr)
- Dim ver As Version = Environment.OSVersion.Version
- Dim isVistaOrHigher As Boolean = ver >= New Version(6, 0)
- Dim isNt61OrHiger As Boolean = ver >= New Version(6, 1)
- If isVistaOrHigher Then
- Dim status As CHANGEFILTERSTRUCT = New CHANGEFILTERSTRUCT With {.cbSize = 8}
- For Each msg As UInteger In New UInteger() {WM_DROPFILES, WM_COPYGLOBALDATA, WM_COPYDATA}
- Dim [error] As Boolean = False
- If isNt61OrHiger Then
- [error] = Not ChangeWindowMessageFilterEx(handle, msg, MSGFLT_ALLOW, status)
- Else
- [error] = Not ChangeWindowMessageFilter(msg, MSGFLT_ADD)
- End If
- If [error] Then Throw New Win32Exception(Marshal.GetLastWin32Error())
- Next
- End If
- End Sub
- Private Shared Function TryGetDropInfo(ByVal msg As Integer, ByVal wParam As IntPtr, ByRef dropFilePaths As String(), ByRef dropPoint As POINT) As Boolean
- dropFilePaths = Nothing
- dropPoint = New POINT()
- If msg <> WM_DROPFILES Then Return False
- Dim fileCount As UInteger = DragQueryFile(wParam, UInteger.MaxValue, Nothing, 0)
- ReDim dropFilePaths(CInt(fileCount) - 1)
- For i As UInteger = 0 To fileCount - 1
- Dim sb As New StringBuilder(MAX_PATH)
- Dim result As UInteger = DragQueryFile(wParam, i, sb, sb.Capacity)
- If result > 0 Then dropFilePaths(CInt(i)) = sb.ToString()
- Next
- DragQueryPoint(wParam, dropPoint)
- DragFinish(wParam)
- Return True
- End Function
- End Class
|