在這個問題上絞盡腦汁。
我已經成功地利用這個鏈接成功地抓取了一個ListBox(ThunderRT6ListBox特別是)使用WinAPI函式的專案的文本。我想要完成的是從這個串列中選擇并雙擊必要的專案。我已經成功地找到了WindowRect它ListBox本身,但我無法獲得cursor相對于這個 Box 和所需專案的位置。
作為應用程式的作者,我必須提交一個雙擊我ScreenScraping設定專案的雙擊事件以打開一個子視窗,其中引數設定相對于所選專案。
我只會發布我遇到問題的部分 - 再次 - 我已經成功找到資料并能夠獲取WindowRectListBox - 我現在正在嘗試單擊并雙擊所需的專案. 我想我需要然后使用另一個設定我的滑鼠游標位置,winAPI,但是當嘗試獲取Item 時它失敗并為兩個坐標WindowRect給出 0 。x,y我還嘗試了 SendKeys 和其他變體,試圖按值“選擇”專案。. . 這也失敗了。
我正在寫信,VB.NET但不介意用 發布的答案C#,因為有轉換器,而且這些答案對所有事物都更為普遍(這也有助于我學習該語言)。
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
uj5u.com熱心網友回復:
在失去了一些頭發之后,我終于設法弄清楚如何做我需要的。
Unhnd_Exception在 Daniweb 網站上為這個簡潔、直觀的課程贏得了巨大的榮譽。(我正在鏈接到帖子,但也會在Unhnd_Exception's此處發布課程內容,以防該網站出現故障。如果我沒有將其歸因于用戶,請幫助我在不丟失代碼的情況下采取更好的方法 -這是一個救生員!(REF#1))
另外 - 我認為任何涉足 API 領域并努力尋找常量的實際值的人都會非常欣賞以下鏈接。它在代碼的其余部分節省了我的培根。(REF#2) 此外,擁有 MSDN 頁面List Box Messages是我需要的另一個關鍵,因為它包含與這些物件通信的不同方法!(參考#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實際有效(REF#1)
Windows 32 位 API (REF#2) 的常量值
串列框訊息 (REF#3)
全部來自Unhnd_ExceptionDaniweb 的代碼:
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
uj5u.com熱心網友回復:
根據@IInspectable 和@Charles 的建議,這絕對UI Automation是要走的路。對于每種方法,我總是在瀏覽 MSDN 文章時遇到一些問題,因為它們經常使用C 或C#編碼(我想有一天我需要真正學習這些語言,但我離題了)。
對于那些被該UI Automation方法嚇倒的人,我將留下我的另一個答案,因為如果你能掌握它,那將會很有用。. . 但它實際上是在重塑UI Automation嘗試并做到這一點!
使用 MSDN 檔案讓我很困惑,直到我了解了元素/屬性等的結構AndCondition。(進一步的研究還表明,我可以使用組合屬性來構建連接屬性。這很好,但是,我必須感謝這個 YouTube 視頻它采用了UI Automation一種閱讀文本的方法來讓我克服困難。當然,這是一種完全不同的方法/用例,但是結構是相同的,并且視頻 ( Tech Savvy) 的作者使用VB.Net了我真正需要的語言。
下面是我構建的整個子程式 - 從頭開始??!我確信我可以改進它,但在第一次嘗試與我合作時,UI Automation我能夠完成所需的整個程序,而不僅僅是一些作業的一小部分,而且很多。. . . 從長遠來看要容易得多,所以感謝大家提出的建議UI Automation- 這絕對是最好的舉措! 我覺得我在編碼中獲得了“升級”。<3
注意:當處理來自 VB6 的遺留物件(Thunder Frames 等)時,幸運的是,有一個LocalizedControlType屬性可用于在subtree您執行初始程式時找到您的專案!
注意 2:您會注意到我在呼叫時使用了 Click_Object 例程。. . 這不是使用該Invoke方法,因為我在Invoke簡單的按鈕單擊中掛起長達 10 秒或更長時間的呼叫時遇到了麻煩。我知道我可以使用單獨thread dispatcher的.Mouse ClassClick/MoveTo
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 & "TPG\189-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
轉載請註明出處,本文鏈接:https://www.uj5u.com/caozuo/426213.html
