从 VB6 中内置的另一个程序 (ThunderRT6ListBox) 中查找_然后单击_ListBox 项
Finding _and then clicking_ ListBox Items from another program built in VB6 (ThunderRT6ListBox)
为了这个我绞尽脑汁。
我已经成功地利用 this link 成功地抓取了 ListBox（特别是 ThunderRT6ListBox）的项目文本，并使用了 WinAPI 函数。我想要完成的是 select 然后双击这个列表中的必要项目。我已经成功地找到了 ListBox 本身的 WindowRect，但是我无法获得相对于此 Box 和所需项目的 cursor 位置。
作为应用程序的作者，我必须提交双击我 ScreenScraping 设置项目的双击事件以打开一个子项目 window 其中参数是相对于 selected 项目设置。
我只打算 post 我遇到问题的部分 - 再次 - 我已经成功找到数据并且能够获得 ListBox 的 WindowRect -我现在正在尝试单击并双击所需的项目。我想我需要使用另一个 winAPI, 来设置我的鼠标光标位置，但是当试图获取项目的 WindowRect 时它失败了并且两个 x,y 坐标都为 0。我还尝试了 SendKeys 和其他变体，试图按值“Select”该项目。 . .这也失败了。
我在 VB.NET 中写作，但不介意用 C# 编辑 post 的答案，因为有转换器，而且这些答案对于任何事情都更普遍（这也有帮助我也要学习那种语言）。
Public Function GetListBoxContents(ByVal listBoxHwnd As IntPtr) As List(Of String)
Dim cnt As Integer = CInt(SendMessage(listBoxHwnd, LB_GETCOUNT, IntPtr.Zero, Nothing))
Dim listBoxContent As List(Of String) = New List(Of String)()
For i As Integer = 0 To cnt - 1
Dim sb As StringBuilder = New StringBuilder(256)
Dim getTextLen As Integer = CInt(SendMessage(listBoxHwnd, LB_GETTEXTLEN, Nothing, Nothing))
Dim getText As IntPtr = SendMessage(listBoxHwnd, LB_GETTEXT, CType(i, IntPtr), sb)
Dim ComRect As RECT
GetWindowRect(listBoxHwnd, ComRect)
Debug.Print("Rect's x coordinate = " & ComRect.x) 'Produces valid X coord when looking
at listboxHwnd - if I look at "getText"
it fails - I assume because this really
is not
Debug.Print("Rect's y coordinate = " & ComRect.y)
Dim lparam As Integer = MakeLong(ComRect.x, ComRect.y)
SetForegroundWindow(listBoxHwnd)
If sb.ToString Like "*COM5*" Then
Debug.Print("hWnd of ListBox item = ", getText)
WindowsEnumerator.SendMessage(getText, WM_LBUTTONDOWN, &H1, lparam)
WindowsEnumerator.SendMessage(getText, WM_LBUTTONUP, &H1, lparam)
PostMessage(getText, WM_LBUTTONDBLCLK, &H1, lparam)
PostMessage(getText, BM_CLICK, &H1, lparam)
SendInputs.Mouse_Click()
SendInputs.SendKey(Convert.ToChar(13))
SendKeys.SendWait("{ENTER}")
End If
listBoxContent.Add(sb.ToString)
Next
Return listBoxContent
End Function
在掉了一些头发后，我终于想出了如何做我需要做的事。
Daniweb 网站上 Unhnd_Exception 的巨大荣誉，因为它简洁、直观 class。 （我正在 link 浏览 post，但也会 post 浏览 Unhnd_Exception's class 的内容，以防该网站出现故障。如果我没有充分归因于用户，请帮助我在不丢失代码的情况下制定更好的方法 - 这是 life-saver! (REF#1))
此外 - 我认为任何涉足 API 领域并努力寻找 ACTUAL 值的人在 link 之后，Constants 将非常感激这一点。它在代码的其余部分节省了我的培根。 (REF#2) 此外，List Box Messages 的 MSDN 页面是我需要的另一个关键，因为它包含与这些对象通信的不同方法！ (参考#3)
用于完成我的任务的最终方法：
Public Const LB_GETCOUNT As Integer = &H18B ' Gets the count of items in ListBox
Public Const LB_GETTEXTLEN As Integer = &H18A ' Gets Length of Text for given
Item based on hWnd
Public Const LB_GETTEXT As Integer = &H189 ' Gets Text
Public Const LB_GETITEMRECT As Integer = &H198 ' Gets ListBox Item RECT - NOTE:
' This still failed for me and returned
' "0" for all dimensions in this case!
Public Const LB_SELECTSTRING As Integer = &H18C ' Hoped this was useful - not so much
Public Const LB_SETCURSEL As Integer = &H186 ' THIS ONE - NICE Beauty!
'LB_SETCURSEL will focus the selection on the object by index
'It will also scroll the box if there are enough items.
Public Const LB_SETSEL As Integer = &H185 ' Ultimately did not use this one.
Public Function GetListBoxContents(ByVal listBoxHwnd As IntPtr) As List(Of String)
Dim cnt As Integer = CInt(SendMessage(listBoxHwnd, LB_GETCOUNT, IntPtr.Zero, Nothing))
Dim listBoxContent As List(Of String) = New List(Of String)()
For i As Integer = 0 To cnt - 1
Dim sb As StringBuilder = New StringBuilder(256)
Dim itmRect As RECT
Dim getTextLen As Integer = CInt(SendMessage(listBoxHwnd, LB_GETTEXTLEN, Nothing, Nothing))
Dim getText As IntPtr = SendMessage(listBoxHwnd, LB_GETTEXT, CType(i, IntPtr), sb)
SendMessage(getText, LB_SETCURSEL, CType(i, IntPtr), Nothing)
Dim ComRect As RECT
GetWindowRect(listBoxHwnd, ComRect)
Debug.Print("Rect's x coordinate = " & ComRect.x)
Debug.Print("Rect's y coordinate = " & ComRect.y)
Debug.Print("Rect's h coordinate = " & ComRect.h)
Debug.Print("Rect's w coordinate = " & ComRect.w)
SendMessageRect(getText, LB_GETITEMRECT, CType(i, IntPtr), itmRect)
Debug.Print("itmRect's x coordinate = " & itmRect.x) 'All of these returned 0's
Debug.Print("itmRect's y coordinate = " & itmRect.y) 'Perhaps I'm calling the routine
Debug.Print("itmRect's h coordinate = " & itmRect.h) 'incorrectly??? Would love to know
Debug.Print("itmRect's w coordinate = " & itmRect.w) 'why this fails.
SetCursorPos(ComRect.x + 10, ComRect.h - 10) 'THIS ONE. Moves my cursor in position
'to select the appropriate object.
'If I could make the GETITEMRECT
SetForegroundWindow(listBoxHwnd) 'Method to work, this would be MOST ideal
'As it would always be concurrent
'with the given item and be less
If sb.ToString Like "*COM5*" Then 'prone to failure. Moves selection to bottom.
Debug.Print("hWnd of ListBox item = ", getText)
SendMessage(listBoxHwnd, LB_SETCURSEL, CType(i, IntPtr), Nothing)
SendInputs.Double_Click() ' Here is the clicker - worked like a champ
End If
listBoxContent.Add(sb.ToString)
Next
Return listBoxContent
End Function
Sendinput that actually works (REF#1)
Value of the constants for the Windows 32-bit API (REF#2)
Daniweb 上 Unhnd_Exception 中完整使用的代码：
Imports System.Runtime.InteropServices
Public Class SendInputs
Private Const KeyDown As Integer = &H0
Private Const KeyUp As Integer = &H2
<DllImport("user32.dll")> _
Private Shared Function SendInput( _
ByVal nInputs As Integer, _
ByVal pInputs() As INPUT, _
ByVal cbSize As Integer) As Integer
End Function
<StructLayout(LayoutKind.Explicit)> _
Private Structure INPUT
'Field offset 32 bit machine 4
'64 bit machine 8
<FieldOffset(0)> _
Public type As Integer
<FieldOffset(8)> _
Public mi As MOUSEINPUT
<FieldOffset(8)> _
Public ki As KEYBDINPUT
<FieldOffset(8)> _
Public hi As HARDWAREINPUT
End Structure
Private Structure MOUSEINPUT
Public dx As Integer
Public dy As Integer
Public mouseData As Integer
Public dwFlags As Integer
Public time As Integer
Public dwExtraInfo As IntPtr
End Structure
Private Structure KEYBDINPUT
Public wVk As Short
Public wScan As Short
Public dwFlags As Integer
Public time As Integer
Public dwExtraInfo As IntPtr
End Structure
Private Structure HARDWAREINPUT
Public uMsg As Integer
Public wParamL As Short
Public wParamH As Short
End Structure
Public Shared Sub SendKey(ByVal key As Char)
Dim Inpts(1) As INPUT
'key down
Inpts(0).type = 1
Inpts(0).ki.wVk = Convert.ToInt16(CChar(key))
Inpts(0).ki.dwFlags = KeyDown
'key up
Inpts(1).type = 1
Inpts(1).ki.wVk = Convert.ToInt16(CChar(key))
Inpts(1).ki.dwFlags = KeyUp
SendInput(2, Inpts, Marshal.SizeOf(GetType(INPUT)))
End Sub
End Class
我修改了他的 Button 单击子例程（完整内容如下所示）来完成我需要的（删除了程序中单击按钮的绑定）。如果您复制最后一行 SendInput(2, Inpts, Marshal.SizeOf(GetType(INPUT)))，您实际上会快速连续获得 2 次点击。在我的实现中，我添加了一个“Mouse_Click”例程（如前所述 - 不需要 WinForm Control），我还实现了一个“Double_Click”例程，它给出了我需要的结果。）
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
'raises the key down and up events
Dim Inpts(1) As INPUT
'key down
Inpts(0).type = 1
Inpts(0).ki.wVk = Convert.ToInt16(CChar("J"))
Inpts(0).ki.dwFlags = 0
'key up
Inpts(1).type = 1
Inpts(1).ki.wVk = Convert.ToInt16(CChar("J"))
Inpts(1).ki.dwFlags = 2
SendInput(2, Inpts, Marshal.SizeOf(GetType(INPUT)))
End Sub
根据@IInspectable 和@Charles 的建议，UI Automation 绝对是正确的选择。我在阅读每种方法的 MSDN 文章时总是遇到一些问题，因为他们经常使用 C++ 或 C# 代码（我想总有一天我需要真正学习这些语言，但是我跑题了）。
对于那些被 UI Automation 方法吓倒的人，我将留下我的另一个答案，因为如果你能掌握它 会 有用。 . .但它实际上是重塑 UI Automation 来尝试并做到！
使用 MSDN 文档让我很困惑，直到我了解了 Elements/Properties 的 结构 等（进一步的研究还表明我可以使用 [=16 组合属性=] 来构建合取属性。这很好，但是，我不得不归功于 This YouTube Video，它采用 UI Automation 方法来阅读文本，让我渡过难关。当然，这是完全不同的 approach/use 案例，但结构相同，视频作者 (Tech Savvy) 使用 VB.Net 语言，这正是我真正需要的。
下面是我构建的整个子例程 - 从头开始！我确信我可以改进它，但是对于与 UI Automation 合作的第一次尝试，我能够完成所需的整个过程，而不仅仅是一些工作的一小部分，而且很多。 . . .容易得多 long-run，所以 感谢大家提出的迁移到 UI Automation 的建议 - 这绝对是最好的一步！ 我觉得我在编码中获得了 'Level Up'。 <3
注意：在处理 VB6 遗留对象（Thunder Frames 等）时，值得庆幸的是有一个 LocalizedControlType 属性 可用于在您查找项目时使用走你初始程序的subtree！
注意 2：您会注意到我正在使用 Click_Object 例程进行调用。 . .这不是使用 Invoke 方法，因为我遇到了 Invoke 呼叫挂起长达 10 秒或更长时间的问题，只需单击一个简单的按钮。我知道我可以使用单独的 thread dispatcher 来调用它们，但我最终使用了 Microsft.TestAPI 的 Mouse Class 和 Click/MoveTo 中建议的方法 This SO Article.
Public Shared Sub FindHMUtil(ByVal ComNum As String)
Dim mW As MainWindow = CType(Application.Current.MainWindow, MainWindow)
'If utility is open - need to kill it and restart.
If Process.GetProcessesByName("hmutility").Count > 0 Then
Commands(0, 0) = "/C TaskKill /FI ""imagename eq hmutility.exe"" /F"
Commands(1, 0) = "Successfully able to kill Firmware Utility."
Commands(2, 0) = "Unable TypeOf kill Firmware Utility."
Commands(3, 0) = "Restarting TPG Printer Firmware Utility"
Commands(4, 0) = "Confirming TPG Printer Firmware"
Commands(5, 0) = "False"
MyProcessControl.ProcessCommandLine("cmd.exe", Commands, mW.PrinterCheckText2)
End If
'Restart Utility
Commands(0, 0) = "/C Start ""HmUtil"" ""C:\Program Files (x86)\hmUtility\hmUtility.exe"""
Commands(1, 0) = "Successfully Able to Start Firmware Utility"
Commands(2, 0) = "Unable to Start Firmware Utility"
Commands(3, 0) = "Restarting TPG Printer Firmware Utility"
Commands(4, 0) = "Confirming TPG Printer Firmware"
Commands(5, 0) = "False"
MyProcessControl.ProcessCommandLine("cmd.exe", Commands, mW.PrinterCheckText2)
Thread.Sleep(350)
Dim enumerator As New WindowsEnumerator
'get handle for initial window
'Note - FindWindow API will not find ThunderForm Windows with WindowTitle if they are part of a Thunder Wrapper!!!!
'Leaving this as a construct for myself
Dim hmImg As IntPtr = enumerator.FindWindowInt(Nothing, "Image")
If hmImg = IntPtr.Zero Or hmImg = vbEmpty Or hmImg = 0 Or hmImg = vbNull Then
'keeping as a reminder - sometimes the findwindow API will not find the ThunderForm
hmImg = enumerator.FindWindowInt(ThunderForm, Nothing)
If hmImg = IntPtr.Zero Or hmImg = vbEmpty Or hmImg = 0 Or hmImg = vbNull Then
hmImg = enumerator.FindWindowExInt(Nothing, Nothing, ThunderForm, Nothing)
Debug.Print("Still found nothing mate!")
End If
End If
'get initial window element
Dim hmWind As AutomationElement = AutomationElement.FromHandle(hmImg)
'Get first set of Elements needed from initial window. NOTE: Not all are used immediately, but keeping them read prevents need to find them a 2nd time.
Dim hmWindExecute As AutomationElement = hmWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Execute"))
Dim hmWindResetPrntr As AutomationElement = hmWindExecute.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Reset Printer"))
Dim hmWindSetup As AutomationElement = hmWindExecute.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Setup"))
Dim hmWindSend As AutomationElement = hmWindExecute.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Send"))
Dim hmWindClearStat As AutomationElement = hmWindExecute.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Clear Status"))
Dim hmWindFLashHndl As IntPtr = enumerator.FindWindowExInt(Nothing, Nothing, ThunderFrame, "Flash File Selection")
Dim hmWindPane As AutomationElement = hmWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "pane"))
Dim hmWindPaneBtns As AutomationElementCollection = hmWindPane.FindAll(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "button"))
Click_Object(hmWindPaneBtns(4), hmWindPaneBtns(4).GetClickablePoint)
Dim hmWindFlashFileFrame As AutomationElement = hmWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Flash File Selection"))
Dim hmWindFlashFileBox As AutomationElement = hmWindFlashFileFrame.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "edit"))
Click_Object(hmWindSetup, hmWindSetup.GetClickablePoint)
'Get handle for new setup window
Dim hmSetup As IntPtr = enumerator.FindWindowExInt(Nothing, Nothing, ThunderForm, "Setup")
If hmSetup = IntPtr.Zero Or hmSetup = 0 Or hmSetup = vbEmpty Or hmSetup = vbNull Then
hmSetup = enumerator.FindWindowExInt(Nothing, Nothing, ThunderForm, Nothing)
End If
'Get new window with listbox of ComPorts and get other controls inside new window
Dim hmSetupWind As AutomationElement = AutomationElement.FromHandle(hmSetup)
Dim hMSetupRemove As AutomationElement = hmSetupWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Remove"))
Dim hmSetupOk As AutomationElement = hmSetupWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "OK"))
Dim hmSetupON As AutomationElement = hmSetupWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "On"))
Dim hmSetupClear As AutomationElement = hmSetupWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Clear"))
Dim hmSetupStatList As AutomationElement
Dim hmListHndl As IntPtr = enumerator.FindWindowExInt(Nothing, Nothing, ThunderList, Nothing)
Dim hmListBox As AutomationElement
If hmListHndl = IntPtr.Zero Or hmListHndl = 0 Or hmListHndl = vbEmpty Or hmListHndl = vbNull Then
hmListBox = hmSetupWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "list"))
Else
hmListBox = AutomationElement.FromHandle(hmListHndl)
End If
'Get all ListBoxes of the new window
Thread.Sleep(250)
Dim hmSetupParent As TreeWalker
'iterating through all listboxes - if not original list box then
Dim checkItm As AutomationElement
Dim checkItmCache As New CacheRequest
checkItmCache.Add(AutomationElement.LocalizedControlTypeProperty)
Click_Object(hMSetupRemove, hMSetupRemove.GetClickablePoint)
Dim hmListItems As AutomationElementCollection = hmListBox.FindAll(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "list item"))
For Each hmListItem As AutomationElement In hmListItems
If hmListItem.Current.Name = ComNum Then
'DoubleClick list item for ComPort of Printer
hmListItem.SetFocus()
DoubleClick_Object(hmListItem, hmListItem.GetClickablePoint)
'Get info for new Window
Dim hmPortSetupWindHndl As IntPtr = enumerator.FindWindowExInt(Nothing, Nothing, ThunderForm, Nothing)
Dim hmPortsetupOK As AutomationElement = AutomationElement.FromHandle(hmPortSetupWindHndl).FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Ok"))
'Click OK on new window with Port Settings - Defaults are fine.
Click_Object(hmPortsetupOK, hmPortsetupOK.GetClickablePoint)
'Turn port ON
Click_Object(hmSetupON, hmSetupON.GetClickablePoint)
'Get items from Status Boxt
Dim hmSetupStatFind As TreeWalker
Click_Object(hmSetupOk, hmSetupOk.GetClickablePoint)
Exit For
End If
Next hmListItem
Click_Object(hmWindFlashFileBox, hmWindFlashFileBox.GetClickablePoint)
My.Computer.Clipboard.SetText(MyProcessControl.myPath & "TPG9-798F304A.BIN")
My.Computer.Keyboard.SendKeys("^V", True)
Click_Object(hmWindSend, hmWindSend.GetClickablePoint)
Dim hmStatus As AutomationElement = hmWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Status"))
Dim SectorStrng As String = "Derps"
Do Until SectorStrng.Contains(ComNum & " open")
Dim hmStatLines As AutomationElementCollection = hmStatus.FindAll(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "list item"))
For a = 0 To hmStatLines.Count - 1
If hmStatLines(a).Current.Name.Contains(ComNum & " open") Then
SectorStrng = hmStatLines(a).Current.Name
End If
Next
Dim e As EventArgs
MyProcessControl.ForceUIToUpdate()
MyProcessControl.OnTimedEvent(mW, e)
Loop
If Process.GetProcessesByName("hmutility").Count > 0 Then
Commands(0, 0) = "/C TaskKill /FI ""imagename eq hmutility.exe"" /F"
Commands(1, 0) = "Successfully able to kill Firmware Utility."
Commands(2, 0) = "Unable TypeOf kill Firmware Utility."
Commands(3, 0) = "Restarting TPG Printer Firmware Utility"
Commands(4, 0) = "Confirming TPG Printer Firmware"
Commands(5, 0) = "False"
MyProcessControl.ProcessCommandLine("cmd.exe", Commands, mW.PrinterCheckText2)
End If
End Sub
Public Shared Sub DoubleClick_Object(givenElement As AutomationElement, mousePoint As Point)
givenElement.SetFocus()
'Adding a 1/4 second sleep ensures object has proper focus before clicking - sometimes the routines moved too fast and threw an exception.
Thread.Sleep(250)
Input.Mouse.MoveTo(New System.Drawing.Point(mousePoint.X, mousePoint.Y))
Input.Mouse.DoubleClick(Input.MouseButton.Left)
End Sub
Public Shared Sub Click_Object(givenElement As AutomationElement, mousePoint As Point)
givenElement.SetFocus()
Thread.Sleep(250)
Input.Mouse.MoveTo(New System.Drawing.Point(mousePoint.X, mousePoint.Y))
Input.Mouse.Click(Input.MouseButton.Left)
End Sub
为了这个我绞尽脑汁。
我已经成功地利用 this link 成功地抓取了 ListBox（特别是 ThunderRT6ListBox）的项目文本，并使用了 WinAPI 函数。我想要完成的是 select 然后双击这个列表中的必要项目。我已经成功地找到了 ListBox 本身的 WindowRect，但是我无法获得相对于此 Box 和所需项目的 cursor 位置。
作为应用程序的作者，我必须提交双击我 ScreenScraping 设置项目的双击事件以打开一个子项目 window 其中参数是相对于 selected 项目设置。
我只打算 post 我遇到问题的部分 - 再次 - 我已经成功找到数据并且能够获得 ListBox 的 WindowRect -我现在正在尝试单击并双击所需的项目。我想我需要使用另一个 winAPI, 来设置我的鼠标光标位置，但是当试图获取项目的 WindowRect 时它失败了并且两个 x,y 坐标都为 0。我还尝试了 SendKeys 和其他变体，试图按值“Select”该项目。 . .这也失败了。
我在 VB.NET 中写作，但不介意用 C# 编辑 post 的答案，因为有转换器，而且这些答案对于任何事情都更普遍（这也有帮助我也要学习那种语言）。
Public Function GetListBoxContents(ByVal listBoxHwnd As IntPtr) As List(Of String)
Dim cnt As Integer = CInt(SendMessage(listBoxHwnd, LB_GETCOUNT, IntPtr.Zero, Nothing))
Dim listBoxContent As List(Of String) = New List(Of String)()
For i As Integer = 0 To cnt - 1
Dim sb As StringBuilder = New StringBuilder(256)
Dim getTextLen As Integer = CInt(SendMessage(listBoxHwnd, LB_GETTEXTLEN, Nothing, Nothing))
Dim getText As IntPtr = SendMessage(listBoxHwnd, LB_GETTEXT, CType(i, IntPtr), sb)
Dim ComRect As RECT
GetWindowRect(listBoxHwnd, ComRect)
Debug.Print("Rect's x coordinate = " & ComRect.x) 'Produces valid X coord when looking
at listboxHwnd - if I look at "getText"
it fails - I assume because this really
is not
Debug.Print("Rect's y coordinate = " & ComRect.y)
Dim lparam As Integer = MakeLong(ComRect.x, ComRect.y)
SetForegroundWindow(listBoxHwnd)
If sb.ToString Like "*COM5*" Then
Debug.Print("hWnd of ListBox item = ", getText)
WindowsEnumerator.SendMessage(getText, WM_LBUTTONDOWN, &H1, lparam)
WindowsEnumerator.SendMessage(getText, WM_LBUTTONUP, &H1, lparam)
PostMessage(getText, WM_LBUTTONDBLCLK, &H1, lparam)
PostMessage(getText, BM_CLICK, &H1, lparam)
SendInputs.Mouse_Click()
SendInputs.SendKey(Convert.ToChar(13))
SendKeys.SendWait("{ENTER}")
End If
listBoxContent.Add(sb.ToString)
Next
Return listBoxContent
End Function
在掉了一些头发后，我终于想出了如何做我需要做的事。
Daniweb 网站上 Unhnd_Exception 的巨大荣誉，因为它简洁、直观 class。 （我正在 link 浏览 post，但也会 post 浏览 Unhnd_Exception's class 的内容，以防该网站出现故障。如果我没有充分归因于用户，请帮助我在不丢失代码的情况下制定更好的方法 - 这是 life-saver! (REF#1))
此外 - 我认为任何涉足 API 领域并努力寻找 ACTUAL 值的人在 link 之后，Constants 将非常感激这一点。它在代码的其余部分节省了我的培根。 (REF#2) 此外，List Box Messages 的 MSDN 页面是我需要的另一个关键，因为它包含与这些对象通信的不同方法！ (参考#3)
用于完成我的任务的最终方法：
Public Const LB_GETCOUNT As Integer = &H18B ' Gets the count of items in ListBox
Public Const LB_GETTEXTLEN As Integer = &H18A ' Gets Length of Text for given
Item based on hWnd
Public Const LB_GETTEXT As Integer = &H189 ' Gets Text
Public Const LB_GETITEMRECT As Integer = &H198 ' Gets ListBox Item RECT - NOTE:
' This still failed for me and returned
' "0" for all dimensions in this case!
Public Const LB_SELECTSTRING As Integer = &H18C ' Hoped this was useful - not so much
Public Const LB_SETCURSEL As Integer = &H186 ' THIS ONE - NICE Beauty!
'LB_SETCURSEL will focus the selection on the object by index
'It will also scroll the box if there are enough items.
Public Const LB_SETSEL As Integer = &H185 ' Ultimately did not use this one.
Public Function GetListBoxContents(ByVal listBoxHwnd As IntPtr) As List(Of String)
Dim cnt As Integer = CInt(SendMessage(listBoxHwnd, LB_GETCOUNT, IntPtr.Zero, Nothing))
Dim listBoxContent As List(Of String) = New List(Of String)()
For i As Integer = 0 To cnt - 1
Dim sb As StringBuilder = New StringBuilder(256)
Dim itmRect As RECT
Dim getTextLen As Integer = CInt(SendMessage(listBoxHwnd, LB_GETTEXTLEN, Nothing, Nothing))
Dim getText As IntPtr = SendMessage(listBoxHwnd, LB_GETTEXT, CType(i, IntPtr), sb)
SendMessage(getText, LB_SETCURSEL, CType(i, IntPtr), Nothing)
Dim ComRect As RECT
GetWindowRect(listBoxHwnd, ComRect)
Debug.Print("Rect's x coordinate = " & ComRect.x)
Debug.Print("Rect's y coordinate = " & ComRect.y)
Debug.Print("Rect's h coordinate = " & ComRect.h)
Debug.Print("Rect's w coordinate = " & ComRect.w)
SendMessageRect(getText, LB_GETITEMRECT, CType(i, IntPtr), itmRect)
Debug.Print("itmRect's x coordinate = " & itmRect.x) 'All of these returned 0's
Debug.Print("itmRect's y coordinate = " & itmRect.y) 'Perhaps I'm calling the routine
Debug.Print("itmRect's h coordinate = " & itmRect.h) 'incorrectly??? Would love to know
Debug.Print("itmRect's w coordinate = " & itmRect.w) 'why this fails.
SetCursorPos(ComRect.x + 10, ComRect.h - 10) 'THIS ONE. Moves my cursor in position
'to select the appropriate object.
'If I could make the GETITEMRECT
SetForegroundWindow(listBoxHwnd) 'Method to work, this would be MOST ideal
'As it would always be concurrent
'with the given item and be less
If sb.ToString Like "*COM5*" Then 'prone to failure. Moves selection to bottom.
Debug.Print("hWnd of ListBox item = ", getText)
SendMessage(listBoxHwnd, LB_SETCURSEL, CType(i, IntPtr), Nothing)
SendInputs.Double_Click() ' Here is the clicker - worked like a champ
End If
listBoxContent.Add(sb.ToString)
Next
Return listBoxContent
End Function
Sendinput that actually works (REF#1)
Value of the constants for the Windows 32-bit API (REF#2)
Daniweb 上 Unhnd_Exception 中完整使用的代码：
Imports System.Runtime.InteropServices
Public Class SendInputs
Private Const KeyDown As Integer = &H0
Private Const KeyUp As Integer = &H2
<DllImport("user32.dll")> _
Private Shared Function SendInput( _
ByVal nInputs As Integer, _
ByVal pInputs() As INPUT, _
ByVal cbSize As Integer) As Integer
End Function
<StructLayout(LayoutKind.Explicit)> _
Private Structure INPUT
'Field offset 32 bit machine 4
'64 bit machine 8
<FieldOffset(0)> _
Public type As Integer
<FieldOffset(8)> _
Public mi As MOUSEINPUT
<FieldOffset(8)> _
Public ki As KEYBDINPUT
<FieldOffset(8)> _
Public hi As HARDWAREINPUT
End Structure
Private Structure MOUSEINPUT
Public dx As Integer
Public dy As Integer
Public mouseData As Integer
Public dwFlags As Integer
Public time As Integer
Public dwExtraInfo As IntPtr
End Structure
Private Structure KEYBDINPUT
Public wVk As Short
Public wScan As Short
Public dwFlags As Integer
Public time As Integer
Public dwExtraInfo As IntPtr
End Structure
Private Structure HARDWAREINPUT
Public uMsg As Integer
Public wParamL As Short
Public wParamH As Short
End Structure
Public Shared Sub SendKey(ByVal key As Char)
Dim Inpts(1) As INPUT
'key down
Inpts(0).type = 1
Inpts(0).ki.wVk = Convert.ToInt16(CChar(key))
Inpts(0).ki.dwFlags = KeyDown
'key up
Inpts(1).type = 1
Inpts(1).ki.wVk = Convert.ToInt16(CChar(key))
Inpts(1).ki.dwFlags = KeyUp
SendInput(2, Inpts, Marshal.SizeOf(GetType(INPUT)))
End Sub
End Class
我修改了他的 Button 单击子例程（完整内容如下所示）来完成我需要的（删除了程序中单击按钮的绑定）。如果您复制最后一行 SendInput(2, Inpts, Marshal.SizeOf(GetType(INPUT)))，您实际上会快速连续获得 2 次点击。在我的实现中，我添加了一个“Mouse_Click”例程（如前所述 - 不需要 WinForm Control），我还实现了一个“Double_Click”例程，它给出了我需要的结果。）
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
'raises the key down and up events
Dim Inpts(1) As INPUT
'key down
Inpts(0).type = 1
Inpts(0).ki.wVk = Convert.ToInt16(CChar("J"))
Inpts(0).ki.dwFlags = 0
'key up
Inpts(1).type = 1
Inpts(1).ki.wVk = Convert.ToInt16(CChar("J"))
Inpts(1).ki.dwFlags = 2
SendInput(2, Inpts, Marshal.SizeOf(GetType(INPUT)))
End Sub
根据@IInspectable 和@Charles 的建议，UI Automation 绝对是正确的选择。我在阅读每种方法的 MSDN 文章时总是遇到一些问题，因为他们经常使用 C++ 或 C# 代码（我想总有一天我需要真正学习这些语言，但是我跑题了）。
对于那些被 UI Automation 方法吓倒的人，我将留下我的另一个答案，因为如果你能掌握它 会 有用。 . .但它实际上是重塑 UI Automation 来尝试并做到！
使用 MSDN 文档让我很困惑，直到我了解了 Elements/Properties 的 结构 等（进一步的研究还表明我可以使用 [=16 组合属性=] 来构建合取属性。这很好，但是，我不得不归功于 This YouTube Video，它采用 UI Automation 方法来阅读文本，让我渡过难关。当然，这是完全不同的 approach/use 案例，但结构相同，视频作者 (Tech Savvy) 使用 VB.Net 语言，这正是我真正需要的。
下面是我构建的整个子例程 - 从头开始！我确信我可以改进它，但是对于与 UI Automation 合作的第一次尝试，我能够完成所需的整个过程，而不仅仅是一些工作的一小部分，而且很多。 . . .容易得多 long-run，所以 感谢大家提出的迁移到 UI Automation 的建议 - 这绝对是最好的一步！ 我觉得我在编码中获得了 'Level Up'。 <3
注意：在处理 VB6 遗留对象（Thunder Frames 等）时，值得庆幸的是有一个 LocalizedControlType 属性 可用于在您查找项目时使用走你初始程序的subtree！
注意 2：您会注意到我正在使用 Click_Object 例程进行调用。 . .这不是使用 Invoke 方法，因为我遇到了 Invoke 呼叫挂起长达 10 秒或更长时间的问题，只需单击一个简单的按钮。我知道我可以使用单独的 thread dispatcher 来调用它们，但我最终使用了 Microsft.TestAPI 的 Mouse Class 和 Click/MoveTo 中建议的方法 This SO Article.
Public Shared Sub FindHMUtil(ByVal ComNum As String)
Dim mW As MainWindow = CType(Application.Current.MainWindow, MainWindow)
'If utility is open - need to kill it and restart.
If Process.GetProcessesByName("hmutility").Count > 0 Then
Commands(0, 0) = "/C TaskKill /FI ""imagename eq hmutility.exe"" /F"
Commands(1, 0) = "Successfully able to kill Firmware Utility."
Commands(2, 0) = "Unable TypeOf kill Firmware Utility."
Commands(3, 0) = "Restarting TPG Printer Firmware Utility"
Commands(4, 0) = "Confirming TPG Printer Firmware"
Commands(5, 0) = "False"
MyProcessControl.ProcessCommandLine("cmd.exe", Commands, mW.PrinterCheckText2)
End If
'Restart Utility
Commands(0, 0) = "/C Start ""HmUtil"" ""C:\Program Files (x86)\hmUtility\hmUtility.exe"""
Commands(1, 0) = "Successfully Able to Start Firmware Utility"
Commands(2, 0) = "Unable to Start Firmware Utility"
Commands(3, 0) = "Restarting TPG Printer Firmware Utility"
Commands(4, 0) = "Confirming TPG Printer Firmware"
Commands(5, 0) = "False"
MyProcessControl.ProcessCommandLine("cmd.exe", Commands, mW.PrinterCheckText2)
Thread.Sleep(350)
Dim enumerator As New WindowsEnumerator
'get handle for initial window
'Note - FindWindow API will not find ThunderForm Windows with WindowTitle if they are part of a Thunder Wrapper!!!!
'Leaving this as a construct for myself
Dim hmImg As IntPtr = enumerator.FindWindowInt(Nothing, "Image")
If hmImg = IntPtr.Zero Or hmImg = vbEmpty Or hmImg = 0 Or hmImg = vbNull Then
'keeping as a reminder - sometimes the findwindow API will not find the ThunderForm
hmImg = enumerator.FindWindowInt(ThunderForm, Nothing)
If hmImg = IntPtr.Zero Or hmImg = vbEmpty Or hmImg = 0 Or hmImg = vbNull Then
hmImg = enumerator.FindWindowExInt(Nothing, Nothing, ThunderForm, Nothing)
Debug.Print("Still found nothing mate!")
End If
End If
'get initial window element
Dim hmWind As AutomationElement = AutomationElement.FromHandle(hmImg)
'Get first set of Elements needed from initial window. NOTE: Not all are used immediately, but keeping them read prevents need to find them a 2nd time.
Dim hmWindExecute As AutomationElement = hmWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Execute"))
Dim hmWindResetPrntr As AutomationElement = hmWindExecute.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Reset Printer"))
Dim hmWindSetup As AutomationElement = hmWindExecute.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Setup"))
Dim hmWindSend As AutomationElement = hmWindExecute.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Send"))
Dim hmWindClearStat As AutomationElement = hmWindExecute.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Clear Status"))
Dim hmWindFLashHndl As IntPtr = enumerator.FindWindowExInt(Nothing, Nothing, ThunderFrame, "Flash File Selection")
Dim hmWindPane As AutomationElement = hmWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "pane"))
Dim hmWindPaneBtns As AutomationElementCollection = hmWindPane.FindAll(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "button"))
Click_Object(hmWindPaneBtns(4), hmWindPaneBtns(4).GetClickablePoint)
Dim hmWindFlashFileFrame As AutomationElement = hmWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Flash File Selection"))
Dim hmWindFlashFileBox As AutomationElement = hmWindFlashFileFrame.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "edit"))
Click_Object(hmWindSetup, hmWindSetup.GetClickablePoint)
'Get handle for new setup window
Dim hmSetup As IntPtr = enumerator.FindWindowExInt(Nothing, Nothing, ThunderForm, "Setup")
If hmSetup = IntPtr.Zero Or hmSetup = 0 Or hmSetup = vbEmpty Or hmSetup = vbNull Then
hmSetup = enumerator.FindWindowExInt(Nothing, Nothing, ThunderForm, Nothing)
End If
'Get new window with listbox of ComPorts and get other controls inside new window
Dim hmSetupWind As AutomationElement = AutomationElement.FromHandle(hmSetup)
Dim hMSetupRemove As AutomationElement = hmSetupWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Remove"))
Dim hmSetupOk As AutomationElement = hmSetupWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "OK"))
Dim hmSetupON As AutomationElement = hmSetupWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "On"))
Dim hmSetupClear As AutomationElement = hmSetupWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Clear"))
Dim hmSetupStatList As AutomationElement
Dim hmListHndl As IntPtr = enumerator.FindWindowExInt(Nothing, Nothing, ThunderList, Nothing)
Dim hmListBox As AutomationElement
If hmListHndl = IntPtr.Zero Or hmListHndl = 0 Or hmListHndl = vbEmpty Or hmListHndl = vbNull Then
hmListBox = hmSetupWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "list"))
Else
hmListBox = AutomationElement.FromHandle(hmListHndl)
End If
'Get all ListBoxes of the new window
Thread.Sleep(250)
Dim hmSetupParent As TreeWalker
'iterating through all listboxes - if not original list box then
Dim checkItm As AutomationElement
Dim checkItmCache As New CacheRequest
checkItmCache.Add(AutomationElement.LocalizedControlTypeProperty)
Click_Object(hMSetupRemove, hMSetupRemove.GetClickablePoint)
Dim hmListItems As AutomationElementCollection = hmListBox.FindAll(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "list item"))
For Each hmListItem As AutomationElement In hmListItems
If hmListItem.Current.Name = ComNum Then
'DoubleClick list item for ComPort of Printer
hmListItem.SetFocus()
DoubleClick_Object(hmListItem, hmListItem.GetClickablePoint)
'Get info for new Window
Dim hmPortSetupWindHndl As IntPtr = enumerator.FindWindowExInt(Nothing, Nothing, ThunderForm, Nothing)
Dim hmPortsetupOK As AutomationElement = AutomationElement.FromHandle(hmPortSetupWindHndl).FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Ok"))
'Click OK on new window with Port Settings - Defaults are fine.
Click_Object(hmPortsetupOK, hmPortsetupOK.GetClickablePoint)
'Turn port ON
Click_Object(hmSetupON, hmSetupON.GetClickablePoint)
'Get items from Status Boxt
Dim hmSetupStatFind As TreeWalker
Click_Object(hmSetupOk, hmSetupOk.GetClickablePoint)
Exit For
End If
Next hmListItem
Click_Object(hmWindFlashFileBox, hmWindFlashFileBox.GetClickablePoint)
My.Computer.Clipboard.SetText(MyProcessControl.myPath & "TPG9-798F304A.BIN")
My.Computer.Keyboard.SendKeys("^V", True)
Click_Object(hmWindSend, hmWindSend.GetClickablePoint)
Dim hmStatus As AutomationElement = hmWind.FindFirst(TreeScope.Subtree, New PropertyCondition(AutomationElement.NameProperty, "Status"))
Dim SectorStrng As String = "Derps"
Do Until SectorStrng.Contains(ComNum & " open")
Dim hmStatLines As AutomationElementCollection = hmStatus.FindAll(TreeScope.Subtree, New PropertyCondition(AutomationElement.LocalizedControlTypeProperty, "list item"))
For a = 0 To hmStatLines.Count - 1
If hmStatLines(a).Current.Name.Contains(ComNum & " open") Then
SectorStrng = hmStatLines(a).Current.Name
End If
Next
Dim e As EventArgs
MyProcessControl.ForceUIToUpdate()
MyProcessControl.OnTimedEvent(mW, e)
Loop
If Process.GetProcessesByName("hmutility").Count > 0 Then
Commands(0, 0) = "/C TaskKill /FI ""imagename eq hmutility.exe"" /F"
Commands(1, 0) = "Successfully able to kill Firmware Utility."
Commands(2, 0) = "Unable TypeOf kill Firmware Utility."
Commands(3, 0) = "Restarting TPG Printer Firmware Utility"
Commands(4, 0) = "Confirming TPG Printer Firmware"
Commands(5, 0) = "False"
MyProcessControl.ProcessCommandLine("cmd.exe", Commands, mW.PrinterCheckText2)
End If
End Sub
Public Shared Sub DoubleClick_Object(givenElement As AutomationElement, mousePoint As Point)
givenElement.SetFocus()
'Adding a 1/4 second sleep ensures object has proper focus before clicking - sometimes the routines moved too fast and threw an exception.
Thread.Sleep(250)
Input.Mouse.MoveTo(New System.Drawing.Point(mousePoint.X, mousePoint.Y))
Input.Mouse.DoubleClick(Input.MouseButton.Left)
End Sub
Public Shared Sub Click_Object(givenElement As AutomationElement, mousePoint As Point)
givenElement.SetFocus()
Thread.Sleep(250)
Input.Mouse.MoveTo(New System.Drawing.Point(mousePoint.X, mousePoint.Y))
Input.Mouse.Click(Input.MouseButton.Left)
End Sub