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
@@ -1,4 +1,5 @@
 Imports System.ComponentModel
+Imports System.Windows.Interop

 Public Class FormMain

@@ -203,6 +204,8 @@ Public Class FormMain
        End Sub, "UpdateLog Output")
    End Sub

+    Private ReadOnly Helper As New DragFileHelper()
+
    '窗口加载
    Private IsWindowLoadFinished As Boolean = False
    Public Sub New()
@@ -241,7 +244,11 @@ Public Class FormMain
        [AddHandler](DragDrop.DragOverEvent, New DragEventHandler(AddressOf HandleDrag), handledEventsToo:=True)
        '加载 UI
        InitializeComponent()
+
+
+
        Opacity = 0
+        '旧代码
        ''开启管理员权限下的文件拖拽，但下列代码也没用（#2531）
        'If IsAdmin() Then
        '    Log("[Start] PCL 正以管理员权限运行")
@@ -249,6 +256,24 @@ Public Class FormMain
        '    ChangeWindowMessageFilter(&H4A, 1)
        '    ChangeWindowMessageFilter(&H49, 1)
        'End If
+
+        '开启管理员权限下的文件拖拽
+        If IsAdmin() Then
+            AddHandler Me.SourceInitialized,
+            Sub(sender, e)
+                Dim wpfHelper As New WindowInteropHelper(Me)
+                Helper.HwndIntPtrSource = HwndSource.FromHwnd(wpfHelper.Handle)
+                Helper.AddHook()
+            End Sub
+            AddHandler Me.Closing,
+            Sub(sender, e)
+                Helper.RemoveDragHook()
+            End Sub
+            AddHandler Helper.DragDrop,
+            Sub(sender, e)
+                Me.FileDrag(Helper.DropFilePaths)
+            End Sub
+        End If
        '切换到首页
        If Not IsNothing(FrmLaunchLeft.Parent) Then FrmLaunchLeft.SetValue(ContentPresenter.ContentProperty, Nothing)
        If Not IsNothing(FrmLaunchRight.Parent) Then FrmLaunchRight.SetValue(ContentPresenter.ContentProperty, Nothing)
@@ -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
@@ -195,9 +195,7 @@
    <Compile Include="Controls\MyIconTextButton.xaml.vb">
      <DependentUpon>MyIconTextButton.xaml</DependentUpon>
    </Compile>
-
-
-
+    <Compile Include="Modules\Base\ModDragHelper.vb" />
    <Compile Include="Modules\Minecraft\ModComp.vb" />
    <Compile Include="Modules\Minecraft\ModJava.vb" />
    <Compile Include="Modules\Minecraft\ModMod.vb" />
@@ -501,7 +499,6 @@
      <DependentUpon>FormMain.xaml</DependentUpon>
      <SubType>Code</SubType>
    </Compile>
-
    <Page Include="Pages\PageVersion\MyLocalModItem.xaml">
      <Generator>MSBuild:Compile</Generator>
      <SubType>Designer</SubType>
@@ -949,7 +946,6 @@
    <Resource Include="Images\Heads\MCBBS.png" />
  </ItemGroup>
  <ItemGroup>
-
  </ItemGroup>
  <ItemGroup>
    <Resource Include="Images\Blocks\NeoForge.png" />