I try to make an app whitch will make mouse to go to external points on desktop.
I have a problem with this application. I receive error then press the button:
A call to PInvoke function 'WindowsApplication1!WindowsApplication1.Form1::mouse_event' has unbalanced the stack. This is likely because the managed PInvoke signature does not match the unmanaged target signature. Check that the calling convention and parameters of the PInvoke signature match the target unmanaged signature.
Code is:
Public Declare Auto Function SetCursorPos Lib "User32.dll" _
(ByVal X As Integer, ByVal Y As Integer) As Long Public
Declare Auto Function GetCursorPos Lib "User32.dll" _
(ByRef lpPoint As Point) As Long Public
Declare Sub mouse_event Lib "user32" Alias "mouse_event" _
(ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _
ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Public Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
SetCursorPos(x, y) 'moves cursor to x,y position
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0) 'Invoke mouse down event
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0) 'Invoke mouse up event
This is a pretty self-explainable error.
"...PInvoke signature does not match the unmanaged target signature..."
Change your code to this:
<DllImport("user32.dll", CharSet:=CharSet.Auto, ExactSpelling:=True)> _
Public Shared Sub mouse_event(dwFlags As Integer, dx As Integer, dy As Integer, dwData As Integer, dwExtraInfo As IntPtr)
End Sub
mouse_event function
First of all, you are using the API declaration type of VB6, that does not have any advantage compared with the DLLImport, and also you've to update the signature for .NET, change all those Longs for Integers.
Secondly, the mouse_event function has been superseded by the SendInputs method as MSDN says, and recommends the usage of the new method.
So, as a suggestion, you could stop worriying about your P/invoking and use my SendInputs Helper Class which provides easy-of-use methods to set the mouse position and to simulate a mouse-button click.
Example usage:
SendInputs.MousePosition(100, 500)
SendInputs.MouseClick(SendInputs.MouseButton.LeftPress)
Related
From VB .Net, I'm trying to send a string to a textbox of another application but I cannot make it work. I'm able to get the handle and even set the focus to the textbox but my SendMessage function doesn't seem to be correct as I get the error message "SendMessage' has unbalanced the stack. This is likely because the managed PInvoke signature does not match the unmanaged target signature. Check that the calling convention and parameters of the PInvoke signature match the target unmanaged signature."
Here is my code:
Module Module1
Private Const WM_SETTEXT As Int32 = &HC
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As IntPtr) As Long
Private Declare Auto Function FindWindow Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Private Declare Auto Function FindWindowEx Lib "user32" (ByVal hwndParent As IntPtr, ByVal hwndChildAfter As IntPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As IntPtr
Private Declare Auto Function SendMessage Lib "user32" (ByVal hwnd As IntPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As IntPtr
Sub Main()
Dim AppHwnd As IntPtr = FindWindow(vbNullString, "Test Application"
Dim WinHwnd1 As IntPtr = FindWindowEx(AppHwnd, 0&, "SWT_Window0", vbNullString)
Dim WinHwnd2 As IntPtr = FindWindowEx(WinHwnd1, 0&, "SWT_Window0", vbNullString)
Dim WinHwnd3 As IntPtr = FindWindowEx(WinHwnd2, 0&, "SWT_Window0", vbNullString)
Dim TextBoxHwnd1 As IntPtr = FindWindowEx(WinHwnd3, 0&, "Edit", vbNullString)
Dim TextBoxHwnd2 As IntPtr = FindWindowEx(WinHwnd3, TextBoxHwnd1, "Edit", vbNullString)
MsgBox(TextBoxHwnd2)
SetForegroundWindow(TextBoxHwnd2)
SendMessage(TextBoxHwnd2, WM_SETTEXT, 0&, "text")
End Sub
End Module
The line "MsgBox(TextBoxHwnd2)" returns the handle number I found using Window Detective so I'm assuming the code is correct up to this point. Also, I tested "SetForegroundWindow(TextBoxHwnd1)" and the cursor is on the first textbox whereas "SetForegroundWindow(TextBoxHwnd1) sets the cursor on the second textbox.
Your declaration looks like it might have been migrated from legacy VB code, where Long was a 32-bit integer and Integer was only 16-bit (dating to legacy VB's origination in 16-bit Windows). The length of the data types changed in .NET which was created after the shift to universal 32-bit Windows, so Integer is 32-bit and Long is 64-bit.
Moreover, the Windows API itself needed to be updated for 64-bit Windows. SendMessage is one of the functions that has some parameters that are longer in 64-bit because they are expected to hold pointers.
I checked on the native header file declaration of SendMessage and found that:
The parameter Msg is declared as UINT which would correspond to Integer in VB. This needs to be changed regardless of whether you have a 32-bit or 64-bit build.
The parameter wParam is declared as UINT_PTR so it should in fact be Long for a 64-bit build, but Integer for a 32-bit build; if it's possible to declare it as IntPtr and then pass 0 to it, that would probably be best, because it should automatically adjust the length depending on whether you're building for 32-bit or 64-bit.
I am trying to make a macro that records what a user clicked, which then records the mouse coordinates and the delay between the clicks. This will then repeat after some other SendKey changes. How can I detect when I click the mouse when the macro is running? I already know how to get the coordinates and record the delay, but what is the best course of action for detecting the mouse click and also what would be the best way to save all this information? A text file? Here is a snippet of the mouse click events that I use:
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
x As Long
y As Long
End Type
Public pos As POINTAPI ' Declare variable
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
Public Sub SingleClick()
Dim xval, yval
xval = GetSetting("Will's Program Sheet", "DPS Calibration", "PROGRAM X")
yval = GetSetting("Will's Program Sheet", "DPS Calibration", "PROGRAM Y")
Select Case xval
Case Is = "" 'Runs calibrate if it can't find an xval
Call CALIBRATE
End
End Select
SetCursorPos xval, yval 'x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
There is another macro that calls SingleClick where it moves to a constant x and y, clicks, does some magic, and returns to the position before the macro started. So to reiterate, is there a simple or easy to understand method to record multiple clicks and delays between clicks and replay them through Excel VBA?
This is theoretically possible to do, but you'd have to set a hook for WH_MOUSE_LL messages. The problem is that I seriously doubt that VBA can keep up with the volume of messages that are going to be coming through that pipe. It would be like trying drinking from a fire hose in VBA. If you really want to give it a shot, you can see if this works.
But first:
DISCLAIMER
In all likelihood, Excel will stop responding if you set up this Workbook and open it. It will certainlly stop responding if you open the VBE. Do not put this in a spreadsheet that you can't afford to delete. Be fully prepared to have to open it with the shift key down to make edits to the code. You have been warned. I take no responsibility for what you do with this. I know better than to have tried it with any code in the event handler. You will likely crash Excel. You will certainly crash the VBE. You may crash anything or everything else.
That should cover it. So...
In a class called HookHolder:
Option Explicit
Private hook As Long
Public Sub SetHook()
hook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf ClickHook, _
0, GetCurrentThreadId)
End Sub
Public Sub UnsetHook()
'IMPORTANT: You need to release the hook when you're done with it.
UnhookWindowsHookEx hook
End Sub
In ThisWorkbook:
Option Explicit
Private danger As HookHolder
Private Sub Workbook_Open()
Set danger = New HookHolder
danger.SetHook
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
danger.UnsetHook
End Sub
In a Module:
Option Explicit
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const HC_ACTION As Long = 0
Public Const WH_MOUSE_LL As Long = &H2
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONUP As Long = &H202
Public Const WM_LBUTTONDBLCLK As Long = &H203
'Your callback function.
Public Function ClickHook(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode = HC_ACTION Then
'Anything in particular you're interest in?
Select Case wParam
Case WM_LBUTTONDOWN
'Do your thing.
Case WM_LBUTTONUP
'Do your thing.
Case WM_LBUTTONDBLCLK
'Do your thing.
End Select
End If
CallNextHookEx 0, nCode, wParam, ByVal lParam
End Function
I am working with mouse code. I am trying to move a mouse to an external application point or make it go to button from external application? For example, move it to a windows calculator button and press it with a program.
Is there a way to invoke a button press on an external application or change the focus to another application using vb?
If you know the position of the button to click, lets say x,y in screen coordinates you can do:
Public Declare Auto Function SetCursorPos Lib "User32.dll" _
(ByVal X As Integer, ByVal Y As Integer) As Long
Public Declare Auto Function GetCursorPos Lib "User32.dll" _
(ByRef lpPoint As Point) As Long
Public Declare Sub mouse_event Lib "user32" Alias "mouse_event" _
(ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _
ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Public Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
SetCursorPos(x, y) 'moves cursor to x,y position
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0) 'Invoke mouse down event
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0) 'Invoke mouse up event
The mouse down and mouse up events simulate the click of the button. Hope that helps
valter
I am implementing an application in C#.net that is passing a message to an VB6 application.
For testing I created 2 applications both in C#.NET:- One sends message and 2nd receives the message.
The receiving application (C#.NET) makes use of the following function to catch the message:-
Protected Override void WndProc(ref Message m)
I now need to implement this receiver app in VB6.. How do we implement Protected Override void WndProc(ref Message m) in VB6? Or is there any other alternative?
Overriding the default windows procedure is possible in VB6 and is called Subclassing.
In a module:
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC As Long = (-4)
Private originalWindowProcAddr As Long
Public Sub subclassForm(hwnd As Long)
'// replace existing windows procedure save its address
originalWindowProcAddr = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
Public Function NewWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Debug.Print "received message for:", hwnd, "message:", uMsg
'// forward message to default
NewWindowProc = CallWindowProc(originalWindowProcAddr, hwnd, uMsg, wParam, lParam)
End Function
Public Sub unSubclassForm(hwnd As Long)
'// must tidy up by restoring the original window proc
SetWindowLong hwnd, GWL_WNDPROC, originalWindowProcAddr
End Sub
In the form
Private Sub Form_Load()
subclassForm Me.hwnd
End Sub
Private Sub form_Unload(Cancel As Integer)
unSubclassForm Me.hwnd
End Sub
Failing to call unSubclassForm will crash the VB IDE, as will breaking into debug mode.
I have followed this method:-
http://support.microsoft.com/kb/176058/en-us
Alternate link: https://web.archive.org/web/20150118054920/http://support.microsoft.com:80/kb/176058
How To Pass String Data Between Applications Using SendMessage
SUMMARY
There are many ways to achieve inter-process communication using Visual Basic. Unless you establish an OLE Automation client server relationship, string data is difficult to handle cleanly. The main reason is that 32-bit applications run in a separate address space, so the address of a string in one application is not meaningful to another application in a different address space. Using the SendMessage() API function to pass a WM_COPYDATA message avoids this problem.
This article demonstrates how to pass string data from one application to another by using the SendMessage API function with the WM_COPYDATA message.
WARNING: One or more of the following functions are discussed in this article; VarPtr, VarPtrArray, VarPtrStringArray, StrPtr, ObjPtr. These functions are not supported by Microsoft Technical Support. They are not documented in the Visual Basic documentation and are provided in this Knowledge Base article "as is." Microsoft does not guarantee that they will be available in future releases of Visual Basic.
Visual Basic does not support pointers and castings in the manner of Visual C++. In order to pass string data from one Visual Basic application to another, the Unicode string must be converted to ASCII prior to passing it to the other application. The other application must then convert the ASCII string back to Unicode.
The following summarizes how to pass string data from one application to another.
Step-by-Step Example
Convert the string to a byte array using the CopyMemory() API.
Obtain the address of the byte array using the VarPtr() intrinsic function and copy the address and length of the byte array into a COPYDATASTRUCT structure.
Pass the COPYDATASTRUCT to another application using the WM_COPYDATA message, setting up the other application to receive the message.
Unpack the structure on the target system using CopyMemory(), and convert the byte array back to a string using the StrConv() intrinsic function.
The next section shows you how to create a sample program that demonstrates passing string data from one application to another.
Steps to Create the Sample
To create this sample, you create two separate projects; a sending project and a target project.
Create the target application:
Start a new Standard EXE project in Visual Basic. Form1 is created by default. This project will be your target application.
Add a Label control to Form1.
Copy the following code to the Code window of Form1:
Private Sub Form_Load()
gHW = Me.hWnd
Hook
Me.Caption = "Target"
Me.Show
Label1.Caption = Hex$(gHW)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook
End Sub
Add a module to the project and paste the following code in the Module1 code window:
Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Public Const GWL_WNDPROC = (-4)
Public Const WM_COPYDATA = &H4A
Global lpPrevWndProc As Long
Global gHW As Long
'Copies a block of memory from one location to another.
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As _
Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As _
Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As _
Long) As Long
Public Sub Hook()
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
AddressOf WindowProc)
Debug.Print lpPrevWndProc
End Sub
Public Sub Unhook()
Dim temp As Long
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_COPYDATA Then
Call mySub(lParam)
End If
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, _
lParam)
End Function
Sub mySub(lParam As Long)
Dim cds As COPYDATASTRUCT
Dim buf(1 To 255) As Byte
Call CopyMemory(cds, ByVal lParam, Len(cds))
Select Case cds.dwData
Case 1
Debug.Print "got a 1"
Case 2
Debug.Print "got a 2"
Case 3
Call CopyMemory(buf(1), ByVal cds.lpData, cds.cbData)
a$ = StrConv(buf, vbUnicode)
a$ = Left$(a$, InStr(1, a$, Chr$(0)) - 1)
Form1.Print a$
End Select
End Sub
Save the project and minimize the Visual Basic IDE.
Create the Sending Application
Start a second instance of the Visual Basic IDE and create a new Standard EXE project in Visual Basic. Form1 is created by default.
Add a CommandButton to Form1.
Copy the following code to the Code window of Form1:
Private Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Private Const WM_COPYDATA = &H4A
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal _
wParam As Long, lParam As Any) As Long
'Copies a block of memory from one location to another.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Sub Command1_Click()
Dim cds As COPYDATASTRUCT
Dim ThWnd As Long
Dim buf(1 To 255) As Byte
' Get the hWnd of the target application
ThWnd = FindWindow(vbNullString, "Target")
a$ = "It Works!"
' Copy the string into a byte array, converting it to ASCII
Call CopyMemory(buf(1), ByVal a$, Len(a$))
cds.dwData = 3
cds.cbData = Len(a$) + 1
cds.lpData = VarPtr(buf(1))
i = SendMessage(ThWnd, WM_COPYDATA, Me.hwnd, cds)
End Sub
Private Sub Form_Load()
' This gives you visibility that the target app is running
' and you are pointing to the correct hWnd
Me.Caption = Hex$(FindWindow(vbNullString, "Target"))
End Sub
Save the project.
Running the Sample
Restore the target application and press the F5 key to run the project. Note that the value of the hWnd displayed in the label.
Restore the sending application and press the F5 key to run the project. Verify that the hWnd in the form caption matches the hWnd in the label on the target application. Click the CommandButton and the text message should be displayed on the form of the target application.
I am using this sample as a basis for a program I'm making. After approximately 618 keystrokes, the program throws this error:
CallbackOnCollectedDelegate was detected
Message: A callback was made on a garbage collected delegate of type 'KeyLogger!KeyLogger.CallBackFunction+DelegateCallBack::Invoke'. This may cause application crashes, corruption and data loss. When passing delegates to unmanaged code, they must be kept alive by the managed application until it is guaranteed that they will never be called.
The error is thrown most times the application is run, but not every time and not at the same keystroke count. From the error message, I think it sounds like the garbage collector is collecting the delegate, how can I prevent this?
The program I made is essentially a modified version of that vb.net project, but it does not actually store the keystrokes.
Thank you for your help!
Code within CallBack.vb:
Option Strict Off
Option Explicit On
Module CallBackFunction
'******************************************************************************************
' Sample for retrieving keystrokes by use of the "kbLog32.dll"
' (c) 2004 by Nadeem Afanah.
'******************************************************************************************
'CallBack function
Delegate Sub DelegateCallBack(ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer)
Sub CallBack(ByVal msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer)
'here we track only WM_CHAR and WM_KEYDOWN
If msg = WM_KEYDOWN Then
...
End If
End Sub
End Module
Code in Declarations.vb:
Option Strict Off
Option Explicit On
Module Declarations
'******************************************************************************************
' Sample for retrieving keystrokes by use of the "kbLog32.dll"
' (c) 2004 by Nadeem Afanah.
'******************************************************************************************
'******************************************************************************************
'DLL declarations
Public Declare Function StartLog Lib "kbLog32" (ByVal hWnd As Integer, ByVal lpFuncAddress As DelegateCallBack) As Integer
Public Declare Sub EndLog Lib "kbLog32" ()
'----------------------------------------------------------------------------------------
Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
Declare Function FindWindow Lib "user32" Alias "FindWindowA"(ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA"(ByVal hWnd1 As Integer, ByVal hWnd2 As Integer, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer
'****************************************************************************************
' Keyboard messages
Public Const WM_KEYUP As Short = &H101s
Public Const WM_KEYDOWN As Short = &H100s
Public Const WM_CHAR As Short = &H102s
Public Const WM_SYSKEYDOWN As Short = &H104s
Public Const WM_SYSKEYUP As Short = &H105s
'SetWindowPos messages
Public Const SWP_NOSIZE As Short = &H1s
Public Const SWP_NOMOVE As Short = &H2s
Public Const HWND_TOPMOST As Short = -1
Public Const SWP_SHOWWINDOW As Short = &H40s
'******************************************************************************************
End Module
Look at the code in Form1.vb where it does this:
StartLog(nhWnd_text, AddressOf CallBack)
This is where it's saying, take the location of the Callback function an use it to hanle messages I receive regarding keyboard events.
Try something like this:
Friend Class Form1
Inherits System.Windows.Forms.Form
''Add this ----------------------------
<MarshalAs(UnmanagedType.FunctionPtr)> _
Private DelSub as New DelegateCallBack(AdressOf CallBack)
''-------------------------------------
''In the sub Sub Command1_Click
''Change this -------------------------
StartLog(nhWnd_text, AddressOf CallBack)
''To this -----------------------------
StartLog(nhWnd_text, DelSub)
''-------------------------------------
End Class
What we're doing here is creating a local "delegate sub" (think of it as a variable which points at a sub). We're pointing this at the Callback sub. We're then using this delegate sub instead of passing in a reference directly to the Callback sub.
The difference is that the .Net framework now knows that there is something pointing at that sub so won't garbage collect it (clear it from memory)
The MarshallAs bit is a little superfluous as that's the default marshalling but it simply means we're explicitly telling .Net that we're using the delegate to access unmanaged code (something outside the .Net framework)
Just for the record, I still had to download the code as it was actually the bit in Form1.vb that was relevant - But thanks for trying :)