VB.net send keypress to game - vb.net

ive seen other questions about this issue but none of them resolved it for me so here i go. I'm trying to send a keypress to a game to save the progress(its a 64bit game). what i've coded so far is :
Dim p() As Process
Dim GameID As Integer = 0
Dim p As Process() = Process.GetProcessesByName("Gamename")
If p.Length > 0 Then
For i As Integer = 0 To p.Length - 1
GameID = (p(i).Id)
Next
End If
AutoSaveTimer.Enabled = True
Dim Test As Integer = 0
GetAsyncKeyState(Test)
AppActivate("GameName")
My.Computer.Keyboard.SendKeys(";", True)
now i've tried Sendkeys.Send(";") but without luck, and the game runs under "GameName" but then the keypress needs to be sent in a window under the game :
Blacked out is the game and under the first window is where the keypress needs to be sent
thanks in advance for the help

I use InputSimulator in my app and it works great.
https://inputsimulator.codeplex.com/
It could be this easy to send keys. The active window will see that as if the user actually used those keys.
var sim = new InputSimulator();
sim.Keyboard.KeyPress(VirtualKeyCode.SPACE);
sim = null;
Here's a screen shot of the methods you can use for keyboard.

You can simulate keyboard input to a program like this:
<DllImport("user32.dll")> _
Public Shared Function SetForegroundWindow(hWnd As IntPtr) As Boolean
End Function
Public Sub Send()
Dim p As System.Diagnostics.Process() = System.Diagnostics.Process.GetProcessesByName("notepad")
'search for process notepad
If p.Length > 0 Then
'check if window was found
'bring notepad to foreground
SetForegroundWindow(p(0).MainWindowHandle)
End If
SendKeys.SendWait("a")
'send key "a" to notepad
End Sub

Related

FindWindowEx random failures getting child window handle

I have a VB.NET 4.6.1 desktop app that has been using FindWindow and FindWindowEx for over 2 years with no issue to locate a MDI child window and capture the window caption text, it has worked flawlessly until recent.
The behavior now is my app can only successfully obtain the MDI client window handle if I go back to either the parent window or MDI client and click anywhere on either window, then return to my app and the process succeeds.
I have tried adding threading sleep events, running the action continuously in a loop multiple times, calling AppActivate method using process ID (thinking I just needed to execute again), my next workaround thought is to try and send a click event to the parent window prior to my action being executed or maybe to use Enumerate all child windows of the parent, hope someone can suggest something because I am at a roadblock, been doing this for years but this one doesn't make sense to me, I have the suspicion that it is related to recent ownership of the software company and them revising this section, but I have no idea why it would interfere with these root level API methods.
Sample Code:
MDIhWnd = FindWindowEx(ParenthWnd, IntPtr.Zero, "WindowsForms10.MDICLIENT.app.0.34f5582_r7_ad1", Nothing)
'Threading.Thread.Sleep(100)
'AppActivate(proc(0).Id)
If MDIhWnd = 0 Then
Threading.Thread.Sleep(100)
'Dim hw = GetTopWindow(ParenthWnd)
For i = 0 To 500
AppActivate(proc(0).Id)
MDIhWnd = FindWindowEx(ParenthWnd, IntPtr.Zero, "WindowsForms10.MDICLIENT.app.0.34f5582_r7_ad1", Nothing)
If MDIhWnd <> 0 Then
Exit For
End If
Next
End If
The solution for me was, based on the above suggestion, to use UI Automation, I
had never worked with it before, however after looking it over I gave a go and
found that it did indeed simplify my needs to capture window text from a 3rd party application window with MDI Client Interface.
Below is a lessor version in VB.NET of the process for anyone needing to do the
same thing:
Imports System.Windows.Automation
' You will also need references to UIAutomationClient, and UIAutomationTypes
Private Sub test_ui_automation()
Dim ParenthWnd As Integer = 0
Dim _AutomationElementA As System.Windows.Automation.AutomationElement = Nothing
Dim _AutomationElementB As System.Windows.Automation.AutomationElement = Nothing
Dim _AutomationElementC As System.Windows.Automation.AutomationElement = Nothing
Dim propCondition As Condition
Try
'Parent Windows Process Stuff
ParenthWnd = FindWindow(Nothing, "Application to Find")
_AutomationElementA = AutomationElement.FromHandle(ParenthWnd)
If _AutomationElementA Is Nothing Then
NotifyIcon1.BalloonTipIcon = ToolTipIcon.Error
NotifyIcon1.BalloonTipText = "Couldn't Locate Parent Window."
NotifyIcon1.Visible = True
NotifyIcon1.ShowBalloonTip(3000)
Exit Sub
End If
' MDI Client Stuff
' I used ClassNameProperty but other conditions are available
propCondition = New PropertyCondition(AutomationElement.ClassNameProperty, "WindowsForms10.MDICLIENT.app.0.34f5582_r7_ad1", PropertyConditionFlags.IgnoreCase)
_AutomationElementB = _AutomationElementA.FindFirst(TreeScope.Element Or TreeScope.Children, propCondition)
If _AutomationElementB Is Nothing Then
NotifyIcon1.BalloonTipIcon = ToolTipIcon.Warning
NotifyIcon1.BalloonTipText = "Application warning MDIClient not Available!"
NotifyIcon1.Visible = True
NotifyIcon1.ShowBalloonTip(3000)
Exit Sub
End If
' Final Stage Stuff Locate Window Containing Class with Caption
propCondition = New PropertyCondition(AutomationElement.ClassNameProperty, "WindowsForms10.Window.8.app.0.34f5582_r7_ad1", PropertyConditionFlags.IgnoreCase)
_AutomationElementC = _AutomationElementB.FindFirst(TreeScope.Element Or TreeScope.Children, propCondition)
If _AutomationElementC Is Nothing Then
NotifyIcon1.BalloonTipIcon = ToolTipIcon.Warning
NotifyIcon1.BalloonTipText = "Automation warning, MDI Details are open."
NotifyIcon1.Visible = True
NotifyIcon1.ShowBalloonTip(3000)
Exit Sub
End If
Caption = _AutomationElementC.Current.Name
' If needed you can now parse/strip any data needed from the Caption text.
' I had other processes here but could not include in the post.
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub

Unsure on proper use of Serial Port Data Received Event

I'm working on a VSTO add-in for Excel 2013 in VB.NET that will help me interface with an instrument via a serial connection. I currently have the COM connection set up correctly and it will allow me to send and receive one command at a time. I'd like to set it up so that I can push one button and have it collect two separate readings in different worksheet cells. Using the code below, the tools work great to collect a single reading, but when I enable the code to send a second command to the instrument the Data Received event stops working entirely until I send another single read command. I know that the instrument received and processed the second command, but it never appears in excel. Could anyone help with a way to modify this code?
Private Sub mySerialPort_DataReceived(ByVal sender As Object, ByVal e As SerialDataReceivedEventArgs)
'Handles serial port data received events
UpdateFormDeligate1 = New UpdateFormDeligate(AddressOf UpdateDisplay)
Dim n As Integer = mySerialPort.BytesToRead 'find number of bytes in buff
comBuffer = New Byte(n - 1) {} 're-dimension storage buffer (n - 1)
mySerialPort.Read(comBuffer, 0, n) 'read data from the buffer
comBuffer2 = mySerialPort.ReadTo(vbCr)
Me.Invoke(UpdateFormDeligate1) 'call the deligate
mySerialPort.Close()
End Sub
Private Sub Invoke(updateFormDeligate1 As UpdateFormDeligate)
lblReading.Label = processReading() 'write to a Current Reading lable on the ribbon
Dim myApp As Excel.Application = Globals.ThisAddIn.Application
Dim currentCell = myApp.ActiveCell
currentCell.Value = processReading() 'write data in the excel active cell
Try
advanceCell()
Catch ex As Exception
System.Windows.Forms.MessageBox.Show(ex.Message)
End Try
If measureNo = 2 Then 'this case is selected when I want to read 2 measurements with a single button push
cmdSent = 2
sendCommand(measureCmd)
End If
End Sub
Private Sub UpdateDisplay()
End Sub
Note that I did not include my sendCommand sub because this is a simple .write command to the instrument that appears to be working correctly in all cases. I'd much appreciate any help anyone could provide as I'm pretty new to using data received events.
OK, I tried to isolate only the relevant the part of the script that was having an issue and I created a completely new toolbar for testing. Below is the full code for this new toolbar that contains one connect/measure button and a label that displays the status/result. I tried to comment the code to make it readable, hopefully this helps.
This new toolbar does appear to be working correctly. I'm still a little unsure on my correct usage of the DataReceived event handler in conjunction with the Invoke method (which Visual Studio slightly changed for use with Excel2013). Could anyone please provide comment as to whether I'm still using these events in an unclear way and provide a suggestion on how I may make it better?
Thanks again in advance for any help. I really appreciate it.
Imports Microsoft.Office.Tools.Ribbon
Imports System.IO.Ports
Public Class Measure2x_COM
Dim mySerialPort As New SerialPort
Dim CMD As String = "M" & vbCr 'statement telling instrument to measure
Dim measureNo As Integer = 0 'counts the number of measure commands sent to the instrument
Private Delegate Sub UpdateFormDeligate()
Private UpdateFormDeligate1 As UpdateFormDeligate
Dim sngReading As Single 'this is the reading received from the instrument as a single data type
Private Sub setupConnectCOM()
'Open COM and send measure command - this part works correctly
'first, check if serial port is open
If mySerialPort.IsOpen Then 'send measure command
mySerialPort.Write(CMD) 'the instrument will generally take 15.1 sec to perform a measurement before sending the result back
Else
'if serial port is not open, set it up, then open, then send command
'Setup COM --this part works correctly
With mySerialPort
.PortName = "COM3"
.BaudRate = 1200
.DataBits = 7
.Parity = Parity.None
.StopBits = StopBits.Two
.Handshake = Handshake.None
.ReadTimeout = 16000
End With
Try
mySerialPort.Open()
Catch ex As Exception
System.Windows.Forms.MessageBox.Show(ex.Message)
Exit Sub 'exit sub if the connection fails
End Try
Threading.Thread.Sleep(200) 'wait 0.2 sec for port to open
mySerialPort.Write(CMD) 'send measure command after serial port is open
End If
measureNo = 1
lblResult.Label = "Measuring"
End Sub
Private Sub Measure2x_COM_Load(ByVal sender As System.Object, ByVal e As RibbonUIEventArgs) Handles MyBase.Load
AddHandler mySerialPort.DataReceived, AddressOf mySerialPort_DataReceived
End Sub
Private Sub mySerialPort_DataReceived(ByVal sender As Object, ByVal e As SerialDataReceivedEventArgs)
'Handles serial port data received events
UpdateFormDeligate1 = New UpdateFormDeligate(AddressOf UpdateDisplay)
'Read data as it comes back from serial port
'I had to do this in two steps because it, for some reason needs to read
'the +/- symbol as a Byte, then needs to read the ASCII measurement number
'the third part concatenates the data and converts it to a single type
'part 1 - read +/- symbol
Dim comBuffer As Byte()
Dim n As Integer = mySerialPort.BytesToRead 'find number of bytes in buff
comBuffer = New Byte(n - 1) {} 're-dimension storage buffer (n - 1)
mySerialPort.Read(comBuffer, 0, n) 'read data from the buffer
'part 2 - read ASCII measurement number
Dim comBuffer2 As String
comBuffer2 = mySerialPort.ReadTo(vbCr)
'part 3 - concatenate read data and convert to single type
Dim txtReading As String = Nothing
txtReading = System.Text.ASCIIEncoding.ASCII.GetString(comBuffer) & CStr(CInt(comBuffer2) / 10)
sngReading = CSng(txtReading)
'Call the update form deligate
'Visual Studio slightly changed this from the example on Microsoft's website that used a Windows Form
'I tried the code in a windows form and I get the same results
Me.Invoke(UpdateFormDeligate1) 'call the deligate
End Sub
Private Sub Invoke(updateFormDeligate1 As UpdateFormDeligate)
lblResult.Label = sngReading 'set the Result label in the ribbon to equal the received data value
'now place the data received in the active cell in the worksheet
Dim myApp As Excel.Application = Globals.ThisAddIn.Application
Dim currentCell = myApp.ActiveCell
currentCell.Value = sngReading
'advance cell to the next cell
Dim newCell = currentCell
newCell = myApp.ActiveCell.Offset(1, 0)
newCell.Select()
currentCell = newCell
'check if this was the first reading from the instrument
'if it was the first reading, then send a second read command
If measureNo = 1 Then
measureNo = 2 'make sure to change measurement number to 2 to avoid infinite loop
mySerialPort.Write(CMD) 'send command to measure to instrument
End If
End Sub
'the usage of this section changed from the Microsoft Windows Form example
'in function, the mySerialPort_DataREceived(), Invoke(), and UpdateDisplay() functions do appear to be
'working with the same results and same hangups
Private Sub UpdateDisplay()
End Sub
Private Sub btnMeasure_Click(sender As Object, e As RibbonControlEventArgs) Handles btnMeasure.Click
setupConnectCOM() 'connect to COM and send first measure command
End Sub
End Class

Task is running and cannot be finished

Have strange behaviour in my task which is not finishing. I use this all the time but i suppose its because sub i am passing to it is iteracting with form - changing selection and refreshing some listbox probably therefore its stack there but i am not sure. Lets see the code:
This is the sub i want to be run in task:
Public Sub UnselectExistingConnectionsItems()
Dim SentenceId, SubSubKategorieId, SubSectionId As Integer
SubSectionId = CbSubSections.SelectedValue 'combobox
If WithSubSubkategorie = SubSubKategorieEnum.Without Then
SubSubKategorieId = 0
Else
SubSubKategorieId = CbSubSubKategorie.SelectedValue 'combobox
End If
Unselect:
For i As Integer = 0 To LB_Sentences.SelectedItems.Count - 1
Dim sKey As ListBoxItem
sKey = LB_Sentences.SelectedItems(i)
SentenceId = HtmlDescription.HtmlSentence.GetSentenceIdByName(sKey.Text)
If HtmlDescription.HtmlSubSubSections_Sentences.CheckIfConnectionAlreadyExist(SentenceId, SubSectionId, SubSubKategorieId) Then
sKey.IsSelected = False
LB_Sentences.Refresh()
GoTo Unselect
End If
Next
End Sub
i put it to Task like this:
Dim pic As New FrmCircularProgress(eCircularProgressType.Line)
Dim work As Task = Task.Factory.StartNew(Sub()
'--Run lenghty task UnselectExistingConnectionsItems()
'--Close form once done (on GUI thread)
pic.Invoke(New Action(Sub() pic.StopCircular()))
pic.Invoke(New Action(Sub() pic.Close()))
End Sub)
'--Show the form
pic.ShowDialog()
Task.WaitAll(work)
and FrmCircularProgress is just form ( i use it almost everywhere where i have to user wait and its working besides this particural case):
Public Class FrmCircularProgress
Sub New(progressType As DevComponents.DotNetBar.eCircularProgressType)
InitializeComponent()
CircularProgress1.ProgressBarType = progressType
StartCircular()
End Sub
Public Sub StartCircular()
Me.CircularProgress1.IsRunning = True
End Sub
Public Sub StopCircular()
Me.CircularProgress1.IsRunning = False
End Sub
End Class
what could be wrong? is it because procedure is interacting with listbox and combobxes? If so how to fix that, i read something about invoking listbox and comboboxes but have no idea how to fix that.
EDIT:
I think besides those lines:
sKey.IsSelected = False
LB_Sentences.Refresh()
I have to make those:
LB_Sentences.Invoke(Sub() sKey.IsSelected = False
End Sub)
LB_Sentences.Invoke(Sub() LB_Sentences.Refresh()
End Sub)
because i am in diffrent thread. Somehow i dont know how to convert those lines:
SubSectionId = CbSubSections.SelectedValue
SubSubKategorieId = CbSubSubKategorie.SelectedValue
probably loop also have to be invoked. Waiting your help.
There is a rule that says "The only thread that can modify a control in a window is the thread that created the window". Any other thread trying to modify something in the window will generate a cross-thread call exception.
So in your first edit you got it right, you have to invoke the functions.
However, this doesn't fix your problem of not finishing Task.
I believe that doing sKey.IsSelected = False does not unselect anything in your ListBox, therefore causing an infinite loop... Also that Goto statement is very bad programming habits and should not be used. There is always another solution that will make your code easier to debug/maintain/read...
ListBoxItem is not a type that exists in the .Net Framework. So either you created that class either it's something else (and I don't know what...)
What you can do to solve your problem is :
Get the indices of all selected items in a list
Run through your list, and check if they should be selected :
If they should be selected, do nothing
if they shouldn't, unselect them.
Which makes your code like this (and you remove that ugly Label and Goto that you don't want in your code)...
Public Sub UnselectExistingConnectionsItems()
Dim SentenceId, SubSubKategorieId, SubSectionId As Integer
SubSectionId = CbSubSections.SelectedValue 'combobox
If WithSubSubkategorie = SubSubKategorieEnum.Without Then
SubSubKategorieId = 0
Else
SubSubKategorieId = CbSubSubKategorie.SelectedValue 'combobox
End If
'We create an array to remind our initial selection
Dim sel = New Integer(LB_Sentences.SelectedItems.Count - 1) {}
LB_Sentences.SelectedIndices.CopyTo(sel, 0)
For i = 0 To sel.Length - 1
Dim sKey As ListBoxItem
'We get our selected item
sKey = LB_Sentences(sel(i))
SentenceId = HtmlDescription.HtmlSentence.GetSentenceIdByName(sKey.Text)
If HtmlDescription.HtmlSubSubSections_Sentences.CheckIfConnectionAlreadyExist(SentenceId, SubSectionId, SubSubKategorieId) Then
'We must remove it from the selection
LB_Sentences.Invoke(Sub() LB_Sentences.SelectedItems.Remove(sKey))
End If
Next
'We do the Refresh at the end so we gain some process time...
LB_Sentences.Invoke(Sub() LB_Sentences.Refresh())
End Sub

Proper clipboard format for Windows 10 Start Menu element

I'm implementing an IDropTarget COM interface which allow any OLE application to drag it's data over my application. However, it fails when I drop a menu item from Windows 10 Start Menu.
The code works fine with folders and files from the desktop or Windows Explorer, but fails when it comes from the Start Menu.
The code fails in iDataObject::QueryGetData using CFSTR_SHELLIDLIST clipboard format.
Someone knows what is the proper clipboard format used by a Start Menu item in Windows 10? Apparently I could use IDataObject::EnumFormatEtc but can not find any example.
Here is the relevant code:
_format = RegisterClipboardFormat(CFSTR_SHELLIDLIST)
Public Function DragDrop1(ByVal pDataObj As System.IntPtr, ByVal grfKeyState As Integer, ByVal pt As ShellCOM._POINT, ByRef pdwEffect As Integer) As Integer Implements ShellCOM.IDropTarget.DragDrop
Dim DataObj As ShellCOM.IDataObject
DataObj = Marshal.GetTypedObjectForIUnknown(pDataObj, GetType(ShellCOM.IDataObject))
If DataObj IsNot Nothing Then
Dim format As New FORMATETC
Dim medium As New STGMEDIUM
format.cfFormat = _format
format.ptd = 0
format.dwAspect = DVASPECT.DVASPECT_CONTENT
format.lindex = 0
format.Tymed = TYMED.TYMED_HGLOBAL
If DataObj.QueryGetData(format) = S_OK Then <----- code fail here, what is the correct format of an element from Windows 10 Start Menu?
' ....
' ....
End If
End If
Return S_OK
End Function
Problem solved. IDataObject::QueryGetData website indicates that currently only -1 is supported for lindex member. So now my app can get the menu item paths.
format.lindex = -1

How to set focus on other application based on process name VB

How can I set focus on other application based on process name in VB2010?
What I can do now is set focus on other application based on windows name using FindWindow then use SetForegroundWindow. Below is what I currently have
Dim theHandle As IntPtr
theHandle = FindWindow(Nothing, "Gmail: Email from Google")
If theHandle <> IntPtr.Zero Then
SetForegroundWindow(theHandle)
The problem is that FindWindow need exact windows name to works and I don't always know the exact name. (Because my program open up different website that the user enter, so I have no control over they site they open). So is there anyway that I can set focus using the process name instead? (in this case firefox.exe) Any other suggestions are welcome.
Thanks
You can use System.Diagnostics.Process to look up a process by name and then find the window title:
For Each app As Process In Process.GetProcessesByName("firefox")
Dim theHandle As IntPtr = FindWindow(Nothing, app.MainWindowTitle)
If theHandle <> IntPtr.Zero Then
SetForegroundWindow(theHandle)
End If
Next
Use the static GetProcessesByName method and then the MainWindowTitle property. For this sample you would need Import System.Diagnostics to import the right namespace.
Private Sub ActivateApp(ByVal pID As Integer)
Dim p As Process = Process.GetProcessById(pID)
If p IsNot Nothing Then
SetForegroundWindow(p.MainWindowHandle)
End If
End Sub
Then use this:
ActivateApp(System.Diagnostics.Process.GetCurrentProcess.Id)
SendKeys.SendWait("~")