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 Private Shared Function ChangeWindowMessageFilterEx(ByVal hWnd As IntPtr, ByVal msg As UInteger, ByVal action As UInteger, ByRef pChangeFilterStruct As CHANGEFILTERSTRUCT) As Boolean End Function Private Shared Function ChangeWindowMessageFilter(ByVal msg As UInteger, ByVal flags As UInteger) As Boolean End Function Private Shared Sub DragAcceptFiles(ByVal hWnd As IntPtr, ByVal fAccept As Boolean) End Sub Private Shared Function DragQueryFile(ByVal hWnd As IntPtr, ByVal iFile As UInteger, ByVal lpszFile As StringBuilder, ByVal cch As Integer) As UInteger End Function Private Shared Function DragQueryPoint(ByVal hDrop As IntPtr, ByRef lppt As POINT) As Boolean End Function Private Shared Sub DragFinish(ByVal hDrop As IntPtr) End Sub Private Shared Function RevokeDragDrop(ByVal hWnd As IntPtr) As Integer End Function Private Shared Function IsUserAnAdmin() As Boolean End Function Public Structure POINT Public X As Integer Public Y As Integer End Structure 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