Merge pull request #6772 from LuoYun-Team/Drop

fix(Drop): 文件拖拽修复
2025-07-20 18:57:17 +08:00
parent d6575df6ab 5126b257f8
commit 14e14b9810
3 changed files with 179 additions and 6 deletions
@@ -0,0 +1,152 @@
+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