|
■No82816 (Atata!! さん) に返信
> そこでドロップ時にマウスをキャプチャしているウィンドウを取得するという方法であれば、
> 高い確率でドロップ元のプロセスを取得できると思います。
DragDrop の時点ではキャプチャが解除されてしまっていたので、
DragEnter の段階で検査してみました。
Imports System.IO
Imports System.Text
Imports System.Runtime.InteropServices
Public Class Form1
Private WithEvents ListBox1 As ListBox
Public Sub New()
InitializeComponent()
ListBox1 = New ListBox() With {.Name = "ListBox1"}
Me.Padding = New Padding(4)
ListBox1.Dock = DockStyle.Fill
ListBox1.IntegralHeight = False
ListBox1.AllowDrop = True
Controls.Add(ListBox1)
End Sub
''' <summary>URL のドロップのみを受け付ける</summary>
Private Sub ListBox1_DragEnter(sender As Object, e As DragEventArgs) Handles ListBox1.DragEnter
If AllowFormats.Any(AddressOf e.Data.GetDataPresent) Then
e.Effect = DragDropEffects.Link
Dim url As String = ReadUrl(e.Data)
Dim p As Process = DragSource()
ListBox1.Items.Clear()
ListBox1.Items.Add(url)
ListBox1.Items.Add(p.ProcessName)
ListBox1.Items.Add(String.Format("ProcessId={0}", p.Id))
p.Dispose()
Else
e.Effect = DragDropEffects.None
End If
End Sub
Private Function ReadUrl(e As IDataObject) As String
Dim url As String = Nothing
Dim sr As StreamReader = Nothing
sr = (From d In Decoder Where e.GetDataPresent(d.Key, False) Select New StreamReader(DirectCast(e.GetData(d.Key), MemoryStream), d.Value)).FirstOrDefault()
If sr IsNot Nothing Then
url = sr.ReadToEnd()
sr.Dispose()
End If
Return url
End Function
Private Function DragSource() As Process
Dim size As Integer = 24 + IntPtr.Size * 6
Dim p As IntPtr = Marshal.AllocHGlobal(size)
Marshal.WriteInt32(p, 0, size)
Marshal.WriteInt32(p, 4, 0)
GetGUIThreadInfo(IntPtr.Zero, p)
Dim hwndCapture As IntPtr = Marshal.ReadIntPtr(p, 8 + IntPtr.Size * 2)
Marshal.FreeHGlobal(p)
Dim pid As Integer
GetWindowThreadProcessId(hwndCapture, pid)
Return Process.GetProcessById(pid)
End Function
Private Shared AllowFormats() As String = {"UniformResourceLocatorW", "UniformResourceLocator"}
Private Shared Decoder As New Dictionary(Of String, Encoding) From {{"UniformResourceLocatorW", Encoding.Unicode}, {"UniformResourceLocator", Encoding.Default}}
Private Declare Unicode Function GetGUIThreadInfo Lib "USER32" (idThread As IntPtr, ByVal lpgui As IntPtr) As Boolean
Private Declare Unicode Function GetWindowThreadProcessId Lib "USER32" (hWnd As IntPtr, ByRef lpdwProcessId As Integer) As Integer
End Class
|