ModDragHelper.vb 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152
  1. Imports System
  2. Imports System.ComponentModel
  3. Imports System.Runtime.InteropServices
  4. Imports System.Text
  5. Imports System.Windows.Interop
  6. Public Class DragFileHelper
  7. Public Event DragDrop As EventHandler
  8. Public Property DropFilePaths As String()
  9. Get
  10. Return _DropFilePathsBackingField
  11. End Get
  12. Private Set(value As String())
  13. _DropFilePathsBackingField = value
  14. End Set
  15. End Property
  16. Private _DropFilePathsBackingField As String()
  17. Public Property DropPoint As POINT
  18. Get
  19. Return _DropPointBackingField
  20. End Get
  21. Private Set(value As POINT)
  22. _DropPointBackingField = value
  23. End Set
  24. End Property
  25. Private _DropPointBackingField As POINT
  26. Public Property HwndIntPtrSource As HwndSource
  27. Public Sub AddHook()
  28. Me.RemoveDragHook()
  29. Me.HwndIntPtrSource.AddHook(AddressOf WndProc)
  30. Dim handle As IntPtr = Me.HwndIntPtrSource.Handle
  31. If IsUserAnAdmin() Then RevokeDragDrop(handle)
  32. DragAcceptFiles(handle, True)
  33. ChangeMessageFilter(handle)
  34. End Sub
  35. Public Sub RemoveDragHook()
  36. Me.HwndIntPtrSource.RemoveHook(AddressOf WndProc)
  37. DragAcceptFiles(Me.HwndIntPtrSource.Handle, False)
  38. End Sub
  39. 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
  40. Dim filePaths As String() = Nothing
  41. Dim point As POINT = New POINT()
  42. If TryGetDropInfo(msg, wParam, filePaths, point) Then
  43. DropPoint = point
  44. DropFilePaths = filePaths
  45. RaiseEvent DragDrop(Me, EventArgs.Empty)
  46. handled = True
  47. End If
  48. Return IntPtr.Zero
  49. End Function
  50. <DllImport("user32.dll", SetLastError:=True)>
  51. Private Shared Function ChangeWindowMessageFilterEx(ByVal hWnd As IntPtr, ByVal msg As UInteger, ByVal action As UInteger, ByRef pChangeFilterStruct As CHANGEFILTERSTRUCT) As Boolean
  52. End Function
  53. <DllImport("user32.dll", SetLastError:=True)>
  54. Private Shared Function ChangeWindowMessageFilter(ByVal msg As UInteger, ByVal flags As UInteger) As Boolean
  55. End Function
  56. <DllImport("shell32.dll")>
  57. Private Shared Sub DragAcceptFiles(ByVal hWnd As IntPtr, ByVal fAccept As Boolean)
  58. End Sub
  59. <DllImport("shell32.dll", CharSet:=CharSet.Unicode)>
  60. Private Shared Function DragQueryFile(ByVal hWnd As IntPtr, ByVal iFile As UInteger, ByVal lpszFile As StringBuilder, ByVal cch As Integer) As UInteger
  61. End Function
  62. <DllImport("shell32.dll")>
  63. Private Shared Function DragQueryPoint(ByVal hDrop As IntPtr, ByRef lppt As POINT) As Boolean
  64. End Function
  65. <DllImport("shell32.dll")>
  66. Private Shared Sub DragFinish(ByVal hDrop As IntPtr)
  67. End Sub
  68. <DllImport("ole32.dll")>
  69. Private Shared Function RevokeDragDrop(ByVal hWnd As IntPtr) As Integer
  70. End Function
  71. <DllImport("shell32.dll")>
  72. Private Shared Function IsUserAnAdmin() As Boolean
  73. End Function
  74. <StructLayout(LayoutKind.Sequential)>
  75. Public Structure POINT
  76. Public X As Integer
  77. Public Y As Integer
  78. End Structure
  79. <StructLayout(LayoutKind.Sequential)>
  80. Private Structure CHANGEFILTERSTRUCT
  81. Public cbSize As UInteger
  82. Public ExtStatus As UInteger
  83. End Structure
  84. Private Const WM_COPYGLOBALDATA As UInteger = &H49
  85. Private Const WM_COPYDATA As UInteger = &H4A
  86. Private Const WM_DROPFILES As UInteger = &H233
  87. Private Const MSGFLT_ALLOW As UInteger = 1
  88. Private Const MSGFLT_ADD As UInteger = 1
  89. Private Const MAX_PATH As Integer = 260
  90. Private Shared Sub ChangeMessageFilter(ByVal handle As IntPtr)
  91. Dim ver As Version = Environment.OSVersion.Version
  92. Dim isVistaOrHigher As Boolean = ver >= New Version(6, 0)
  93. Dim isNt61OrHiger As Boolean = ver >= New Version(6, 1)
  94. If isVistaOrHigher Then
  95. Dim status As CHANGEFILTERSTRUCT = New CHANGEFILTERSTRUCT With {.cbSize = 8}
  96. For Each msg As UInteger In New UInteger() {WM_DROPFILES, WM_COPYGLOBALDATA, WM_COPYDATA}
  97. Dim [error] As Boolean = False
  98. If isNt61OrHiger Then
  99. [error] = Not ChangeWindowMessageFilterEx(handle, msg, MSGFLT_ALLOW, status)
  100. Else
  101. [error] = Not ChangeWindowMessageFilter(msg, MSGFLT_ADD)
  102. End If
  103. If [error] Then Throw New Win32Exception(Marshal.GetLastWin32Error())
  104. Next
  105. End If
  106. End Sub
  107. Private Shared Function TryGetDropInfo(ByVal msg As Integer, ByVal wParam As IntPtr, ByRef dropFilePaths As String(), ByRef dropPoint As POINT) As Boolean
  108. dropFilePaths = Nothing
  109. dropPoint = New POINT()
  110. If msg <> WM_DROPFILES Then Return False
  111. Dim fileCount As UInteger = DragQueryFile(wParam, UInteger.MaxValue, Nothing, 0)
  112. ReDim dropFilePaths(CInt(fileCount) - 1)
  113. For i As UInteger = 0 To fileCount - 1
  114. Dim sb As New StringBuilder(MAX_PATH)
  115. Dim result As UInteger = DragQueryFile(wParam, i, sb, sb.Capacity)
  116. If result > 0 Then dropFilePaths(CInt(i)) = sb.ToString()
  117. Next
  118. DragQueryPoint(wParam, dropPoint)
  119. DragFinish(wParam)
  120. Return True
  121. End Function
  122. End Class