I want to store all active window title using EnumWindows API function. But I want to use the function which calls EnumWindows as an callback function too. I want to do this by changing the lParam variable so that the function knows when it has to call EnumWindows and when it is the callback function. The problem is that it gives me an error: "Expected Sub,Function or Propriety.". Here's my code:
Private Sub Command1_Click()
ReceiveHwnd 0, 1
End Sub
This part of code is in the module:
Public Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal Hwnd As Long) As Long
Public Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal Hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public HwndCount As Double, HwndArray() As Long
Public Function GetTitle(Hwnd As Long) As String
Dim Lenght As Long
Dim TempValue As String
Lenght = GetWindowTextLength(Hwnd) + 1
TempValue = Space$(Lenght)
GetWindowText Hwnd, TempValue, Lenght
GetTitle = Mid(TempValue, 1, Lenght - 1)
End Function
Public Function ReceiveHwnd(ByVal Hwnd As Long, ByVal lParam As Long) As Long
Static Count As Double
If lParam = 1 Then
EnumWindows AddressOf ReceiveHwnd, 0
Count = 0
Else
Count = Count + 1
ReDim Preserve HwndArray(1 To Count)
HwndArray(Count) = Hwnd
ReceiveHwnd = 1
End If
End Function
The error is at this line EnumWindows AddressOf ReceiveHwnd, 0 from ReceiveHwnd function.
Can you tell me where's the problem?
Related
I am currently modifying a really old system running Windows Server 2k. One of the requirements I am working on is to block off keyboard presses at a certain window of another program which we can't modify.
Generally my process was fine as I detect keypresses and then terminate the window if they occur, However the only working code that I have found and worked with causes many issues when sometimes Control/Windows Key/etc gets stuck and the entire system tends to act out weird. This is the Code I am using for the Hook:
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function SetWindowsHook Lib "user32" Alias "SetWindowsHookA" (ByVal nFilterType As Long, ByVal pfnFilterProc As Long) 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Global Const WH_KEYBOARD_LL = 13
Public hook As Long
Public Const HC_ACTION = 0
Type HookStruct
vkCode As Long
scancode As Long
FLAGS As Long
time As Long
dwExtraInfo As Long
End Type
Public active As Boolean
Public value As String
Public Function myfunc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim kybd As HookStruct
myfunc = True
If code = HC_ACTION And wParam <> 257 Then
If active Then
'SendKeys "{ESC}"
'MsgBox ("keypressed")
End If
myfunc = CallNextHookEx(hook, code, wParam, lParam)
ElseIf code < 0 Then
myfunc = CallNextHookEx(hook, code, wParam, lParam)
End If
End Function
Generally the code IS working, However if you press Control, Alt or Windows key then the entire system tends to go haywire.
Is there a better method to detect those key presses outside the system/in a specific window even possibly, Or am I doing something wrong here?
See the following thread: Detect keypress outside your application
You can try these two other approaches to see if they are more stable:
RegisterHotKey, a function that defines a system-wide hot key:
Declare Function RegisterHotKey Lib "user32" Alias "RegisterHotKey" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
or GetAsyncKeyState, a function that determines whether a key is up or down at the time the function is called, and whether the key was pressed after a previous call to GetAsyncKeyState:
Declare Function GetAsyncKeyState Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Long) As Integer
You could run a timer and continuously check GetAsyncKeyState to see if the key(s) you are looking for have been pressed:
Private Sub tmrKeyPressCheck_Timer()
Dim iCounter As Integer
For iCounter = 64 To 90
If CheckKey(iCounter) Then
txtKeyPressLog.Text = Hour(Now) & ":" & Minute(Now) & ":" & Second(Now) & ": " & Chr(iCounter) & vbCrLf & txtKeyPressLog.Text
End If
Next
End Sub
Private Function CheckKey(ByVal p_lngKey As Long) As Boolean
Dim iReturn As Integer
iReturn = GetAsyncKeyState(p_lngKey)
CheckKey = (iReturn <> 0)
End Function
This is the code that ended up working without the issues:
Private Const WH_KEYBOARD_LL = 13&
Private Const HC_ACTION = 0&
Private Const LLKHF_EXTENDED = &H1&
Private Const LLKHF_INJECTED = &H10&
Private Const LLKHF_ALTDOWN = &H20&
Private Const LLKHF_UP = &H80&
Private Const VK_RIGHT = &H27
Private Const VK_LEFT = &H25
Private Const VK_RSHIFT = &HA1
Private Type KBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
FLAGS As Long
time As Long
dwExtraInfo As Long
End Type
Private 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
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cb As Long)
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public value As String
Public active As Boolean
Public Function HookKeyboard() As Long
On Error GoTo ErrorHookKeyboard
m_hDllKbdHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0&)
HookKeyboard = m_hDllKbdHook
Exit Function
ErrorHookKeyboard:
MsgBox Err & ":Error in call to HookKeyboard()." _
& vbCrLf & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Warning"
Exit Function
End Function
Public Sub UnHookKeyboard()
On Error GoTo ErrorUnHookKeyboard
UnhookWindowsHookEx (m_hDllKbdHook)
Exit Sub
ErrorUnHookKeyboard:
MsgBox Err & ":Error in call to UnHookKeyboard()." _
& vbCrLf & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Warning"
Exit Sub
End Sub
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static kbdllhs As KBDLLHOOKSTRUCT
If nCode = HC_ACTION Then
Call CopyMemory(kbdllhs, ByVal lParam, Len(kbdllhs))
If active Then
MsgBox ("keypressed")
End If
End If
I just need to call HookKeyboard/UnhookKeyboard in the main form
I'm trying to retrieve the text from an EDIT control using GetWindowText and GetWindowTextLength. The application retrieves the text from the window under the cursor and it works on all windows with a caption or text with the exception of the EDIT control. The EDIT control is the result window on the Windows XP Calculator, calc.exe.
Dim S As String
Dim L As Long
L = GetWindowTextLength(handle) + 1
Receiving string = GetWindowText(handle, S, L)
EDIT:
According to SPY++ the Edit class control does not receive the EM_GETSELTEXT or the WM_GETTEXT message.The code below retrieves the text from the Edit class control on the Windows XP calc.exe calculator every time that I press a button on my UI. It is not the method that I would have preferred to use, however, it accomplishes my task.
Const EM_SETSEL = &HB1
Const ES_READONLY = &H800
Const WM_COPY = &H301
Const EM_GETSELTEXT = &H43E
Const WM_GETTEXTLENGTH = &HE
Const WM_SETFOCUS As Long = &H7
Dim L As Long
L = SendMessage(EditHwnd, WM_GETTEXTLENGTH, 0&, 0)
SendMessage EditHwnd, WM_SETFOCUS, 0&, 0
SendMessage EditHwnd, EM_SETSEL, 0&, L
SendMessage EditHwnd, ES_READONLY, 0&, 0 ' read only = false
Clipboard.Clear
SendMessage EditHwnd, WM_COPY, 0&, 0
SendMessage EditHwnd, ES_READONLY, 1&, 0 ' read only = true
Receiving string = Clipboard.GetText
Clipboard.Clear
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Function GetText(handle As Long) As String
Dim S As String, L As Integer, cch As Long
L = GetWindowTextLength(handle) + 1
S = String(L, 0)
GetText = Mid(S, 1, GetWindowText(handle, S, L))
End Function
Private Sub Form_Load()
Dim hw As Long
hw = Me.hwnd
MsgBox GetText(hw)
End Sub
But it will not work with controls like EDIT, as it is written in help. ;( In order to get the text of the child window (control), try to get a list of all windows using API EnumWindows/EnumThreadWindows/GetWindowThreadProcessId, to find the desired control.
What is the name of the class to EDIT You need? What is its width and height? I could write code specifically for the search for this control.
this code works fine in Windows XP (virtual machine)
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As Any, ByVal lpsz2 As Any) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function AttachThreadInput Lib "user32.dll" _
(ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Const WM_GETTEXT As Long = &HD&
Private Const WM_GETTEXTLENGTH As Long = &HE&
Function WindowText(ByVal hWnd As Long) As String
Dim ret As Long
ret = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, ByVal 0&)
WindowText = String(ret, 0)
ret = SendMessage(hWnd, WM_GETTEXT, ret + 1, ByVal WindowText)
End Function
Private Sub Command1_Click()
Dim hCalc As Long, hEdit As Long
hCalc = FindWindow("SciCalc", vbNullString)
hEdit = FindWindowEx(hCalc, 0&, "Edit", vbNullString)
MsgBox WindowText(hEdit)
End Sub
Is there a way to get the equivalent of VB's SelStart and SelLength properties from an Internet Explorer_Server object?
I've tried using SendMessage EM_GETSEL but it doesn't return anything.
You have to query the InternetExplorer_Server's HWND for its IHTMLDocument2 interface, and then you can use the browser's DOM interfaces to manipulate the browser content as needed:
How to get IHTMLDocument2 from a HWND
IHTMLDocument2::selection Property
Use this code where you want to calculate SelStart and SelLength. Replace InternetExplorer_Server.hWnd with a handle to your object.
Dim DomObj As IHTMLDocument2
Dim SelObj As IHTMLTxtRange
Set DomObj = IEDOMFromhWnd(InternetExplorer_Server.hWnd)
Set SelObj = DomObj.selection.createRange
TextToCheck$ = DomObj.body.innerText
' Calculate SelLength...
SelLength = Len(SelObj.Text)
SelObj.moveStart "character", -Len(TextToCheck$)
' Calculate SelStart...
SelStart = Len(SelObj.Text)
Requires the following code in a Module:
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As UUID, ByVal wParam As Long, ppvObject As Any) As Long
Public Function IEDOMFromhWnd(ByVal hwnd As Long) As IHTMLDocument2
Dim IID_IHTMLDocument2 As UUID
Dim hWndChild As Long
Dim lRes As Long
Dim lMsg As Long
Dim hr As Long
' Register the message
lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
' Get the object pointer
Call SendMessageTimeout(hwnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes)
If lRes Then
' Initialize the interface ID
With IID_IHTMLDocument2
.Data1 = &H626FC520
.Data2 = &HA41E
.Data3 = &H11CF
.Data4(0) = &HA7
.Data4(1) = &H31
.Data4(2) = &H0
.Data4(3) = &HA0
.Data4(4) = &HC9
.Data4(5) = &H8
.Data4(6) = &H26
.Data4(7) = &H37
End With
' Get the object from lRes
hr = ObjectFromLresult(lRes, IID_IHTMLDocument2, 0, IEDOMFromhWnd)
End If
End Function
Is there an equivalent to AddressOf in Visual Basic 4?
I am attempting to get some Visual Basic 5/6 code that adds menu items to my form's system menu working in VB4. Below is the code snippet that will not compile:
'Add Custom Menu To System Menu
Call AppendMenu(GetSystemMenu(Me.hWnd, 0&), MF_SEPARATOR, 0&, vbNullString)
Call AppendMenu(GetSystemMenu(Me.hWnd, 0&), MF_STRING, IDM_SYSTEMTRAY, "Minimize To &System Tray")
Call AppendMenu(GetSystemMenu(Me.hWnd, 0&), MF_STRING, IDM_ABOUT, "&About...")
procOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
Here is the API declarations from the module:
' Win32 API
Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Public Const GWL_WNDPROC = (-4)
Public Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
Public Const WM_SYSCOMMAND = &H112
' User Created
Public procOld As Long
Public Const IDM_ABOUT As Long = 1010
Public Const IDM_SYSTEMTRAY As Long = 1011
And finally, the code for WindowProc:
Public Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_SYSCOMMAND
Select Case wParam
Case IDM_ABOUT
MsgBox "About goes here..."
Exit Function
Case IDM_SYSTEMTRAY
MsgBox "Send to system tray code goes here..."
Exit Function
End Select
End Select
' Pass all messages on to VB and then return the value to windows
WindowProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)
End Function
Any other pointers or alternate methods of adding items to my form's system menu would be appreciated too!
From: Xtreme VB Talk: AddressOf work around for vb4
[Banjo]
I don't think that you can without resorting to somesort of outside
DLL written in C.
[OnErr0r]
Matt Curland wrote just such a dll. Allows you to get the address of a class function, even works with vb5/6.
You can download callback.zip from the above page after registering. As a fallback, you can get the file here: callback.zip
EDIT: The direct download link has been removed, because it appears that this source code is part of a book by Matt Curland and copyrighted.
i am trying to implement the Jetaudio API in vb6...
i have taken the values of the constants from the API SDK..
Private Declare Function FindWindow Lib "user32.dll" 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, ByVal lParam As Long) As Long
Private Declare Function RegisterWindowMessage _
Lib "user32" Alias "RegisterWindowMessageA" _
(ByVal lpString As String) As Long
Public Const WM_APP As Long = &H8000
Public Const MyMSG As Long = WM_APP + 740
Public Function GetJetAudioSong()
Dim v As Long
Dim JAhwnd As Long
Dim lngMyMsg As Long
lngMyMsg = RegisterWindowMessage(MyMSG)
JAhwnd = FindWindow("COWON Jet-Audio Remocon Class", "Jet-Audio Remote Control")
v = SendMessage(JAhwnd, lngMyMsg, 0, 995)
MsgBox v
End Function
Now, FindWindow() is working cause JAhwnd is set with a value...
its just the sendmessage() that doesn't seem to be working...
the code is suppose to msgbox the version number for the running Jet Audio instance.
i've been at it for days now and i have no way of making sure weather this error is a VB thing or not... i am taking Jet Audio's SDK's word that the values of the const are correct...
the value of v is always 0 where it should be 6 on my system.
what am i doing wrong?
Don't call RegisterWindowMessage, MyMSG is message number that you should send to the Jet-Audio window.
Private Declare Function FindWindow Lib "user32.dll" 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, ByVal lParam As Long) As Long
Public Const WM_APP As Long = &H8000
Public Const MyMSG As Long = WM_APP + 740
Public Function GetJetAudioSong()
Dim v As Long
Dim JAhwnd As Long
Dim lngMyMsg As Long
JAhwnd = FindWindow("COWON Jet-Audio Remocon Class", "Jet-Audio Remote Control")
v = SendMessage(JAhwnd, MyMSG, 0, 995)
MsgBox v
End Function
What Windows Version?
SendMessage and SendKeys no longer works with VB6 code starting at Windows Vista and above.
Do a Google search for it.
I know this is 2 years too late. Please use this as a future reference for anyone reading this in the future.
The fix for your issue is this:
'[ Use 'ByVal' for your lParam to make sure you are passing the actual value not the Reference
v = SendMessage(JAhwnd, lngMyMsg, 0, ByVal 995)
'[ Or you could perform PostMessage(..) and not use ByVal
v = PostMessage(JAhwnd, lngMyMsg, 0, 995)
Also, i HIGHLY recommend against anyone using SendKeys. API is the correct method to ensure you are sending message to the correct hWnd. I would suggest using SendKeys only if in desperation; it can happen.