I am writing a Little VBA Programm that Needs to wait until a specific windows is open. I want to do this using FindFindow form the user32.dll but i cant get it run. Weird Thing is that even if i set the 2 Parameters of the function to Null, i still get a negative return, although in that case all windows should match. Basically i dont get a result different from 0 for hwnd Independent of how i call FindWindow. I searched Stack OPverflow and i also Googled the Problem but i cant find what i am doing wrong. Any help is appreciated.
Declare Function FindWindow Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Sub Main
Dim hwnd As Long
hwnd = FindWindow(vbNullString, vbNullString)
If (hwnd = 0) Then MsgBox ("failure")
End Sub
The Solutions to similar Problems like How to use FindWindow to find a visible or invisible window with a partial name in VBA dont seem to work either.
The problem is that vbNullString is a length 0 string, the same as "". When that is marshalled to the unmanaged code a non-null pointer to a null-terminated array of characters is passed. Because the length is 0 then a pointer to a null-terminator is passed. That's different from NULL which is the null pointer.
I'm far from a VBA expert, but I think the solution is like so:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByRef lpClassName As Any, ByRef lpWindowName As Any) As Long
If you want to call this passing NULL for both arguments do so like this:
window = FindWindow(ByVal 0&, ByVal 0&)
Alternatively, if you want to pass a string value do it like this:
window = FindWindow(ByVal 0&, ByVal "Untitled - Notepad")
Related
I'm attempting to create a VB6 executable (not sure of the proper syntax) that will toggle the X-Mouse option in Tweak UI under Windows 98SE. Ideally, I would like to have two scripts - one that turns it off (regardless of its state) and one that turns it on (again, regardless of its state).
I have been able to open the TweakUI control panel with the code below.
Private Sub Form_Load()
Call Shell("rundll32.exe shell32.dll,Control_RunDLL tweakui.cpl", vbNormalFocus)
End Sub
If possible, I would like it to do it without opening the TweakUI control panel.
As far as I can tell, changing the registry setting doesn't work as I would have to reboot the computer for that to take effect.
I have Registry Monitor 7.04 running. It captures the following:
Path: C:\WINDOWS\RUNDLL32.EXE
Command Line: "C:\WINDOWS\RUNDLL32.EXE" "C:\WINDOWS\SYSTEM\TWEAKUI.CPL", Tweak UI
Other: hKey: 0xC2A066F0
Honestly, I'm not sure how to move forward.
Not sure the best way to show progress on this, I'll just edit.
This code is very close.
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_SETACTIVEWINDOWTRACKING = 4097
'Click on this button to Activate XMouse
Private Sub Command1_Click()
SystemParametersInfo SPI_SETACTIVEWINDOWTRACKING, 0, True, 0
End Sub
'Click on this button to Deactivate XMouse
Private Sub Command2_Click()
SystemParametersInfo SPI_SETACTIVEWINDOWTRACKING, 0, False, 0
End Sub
Button 1 works correctly and Activates XMouse. But button two does not deactivate it.
SPI_SETACTIVEWINDOWTRACKING is the parameter that does this.
systemparametersinfo is the function call that gets or sets settings like this. See https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-systemparametersinfoa
There is sample code using systemparametersinfo that changes the wallpaper. https://winsourcecode.blogspot.com/2019/06/changewallpaper.html
Thank you to all of the input. I was able to solve this problem.
Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByVal lpvParam As Boolean, ByVal fuWinIni As Long) As Long
Const SPI_SETACTIVEWINDOWTRACKING = 4097
Private Sub Command1_Click()
retVal = SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING, 0, True, 0)
End Sub
Private Sub Command2_Click()
retVal = SystemParametersInfo(SPI_SETACTIVEWINDOWTRACKING, 0, False, 0)
End Sub
In addition to the help here, I stumbled upon a few gems that gave me what I needed.
Control the mouse speed under Windows 98 / 2000
and
Controling Active Window Tracking
A couple things of note. I had to include this or else nothing happened:
Const SPI_SETACTIVEWINDOWTRACKING = 4097
Also, the 3rd parameter was
ByRef lpvParam As Boolean
Instead of
ByVal lpvParam As Boolean
I was passing a pointer to a pointer instead of a pointer to a value
I want to close a certain window.
Spy++ tells me that the window is of class name "ad_win#2":
However, when I use FindWindow like that...
Public Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim lRet&
lRet = FindWindow("ad_win#2", vbNullString)
.... lRet is 0, meaning that it didn't find any window.
What am I doing wrong?
Thank you!
It works when I add a ChrW(10) to the name like this:
Dim lRet&
lRet = FindWindow("ad_win#2" & ChrW(10), vbNullString)
I am declaring and calling a dll function using the following syntax in VB6:
'Declare the function
Private Declare Sub MYFUNC Lib "mylib.dll" ()
'Call the function
MYFUNC
Calling the function results in the error File not found: mylib.dll. This happens when the application is run from the vb6 IDE or from a compiled executable.
The dll is in the working directory, and I have checked that it is found using ProcMon.exe from sysinternals. There are no failed loads, but the Intel Fortran dlls are not loaded (the ProcMon trace seems to stop before then).
I have also tried running the application in WinDbg.exe, and weirdly, it works! There are no failures on this line. The ProcMon trace shows that the Intel Fortran dlls are loaded when the program is run in this way.
The dll is compiled with Fortran Composer XE 2011.
Can anyone offer any help?
When loading DLLs, "file not found" can often be misleading. It may mean that the DLL or a file it depends on is missing - but if that was the case you would have spotted the problem with Process Monitor.
Often, the "file not found" message actually means that the DLL was found, but an error occured when loading it or calling the method.
There are actually three steps to calling a procedure in a DLL:
Locate and load the DLL, running the DllMain method if present.
Locate the procedure in the DLL.
Call the procedure.
Errors can happen at any of these stages. VB6 does all this behind the scenes so you can't tell where the error is happening. However, you can take control of the process using Windows API functions. This should tell you where the error is happening. You can alse set breakpoints and use Process Monitor to examine your program's behaviour at each point which may give you more insights.
The code below shows how you can call a DLL procedure using the Windows API. To run it, put the code into a new module, and set the startup object for your project to "Sub Main".
Option Explicit
' Windows API method declarations
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, _
ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) _
As Long
Private Declare Function FormatMessage Lib "kernel32" Alias _
"FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _
ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) _
As Long
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const MyFunc As String = "MYFUNC"
Const MyDll As String = "mylib.dll"
Sub Main()
' Locate and load the DLL. This will run the DllMain method, if present
Dim dllHandle As Long
dllHandle = LoadLibrary(MyDll)
If dllHandle = 0 Then
MsgBox "Error loading DLL" & vbCrLf & ErrorText(Err.LastDllError)
Exit Sub
End If
' Find the procedure you want to call
Dim procAddress As Long
procAddress = GetProcAddress(dllHandle, MyFunc)
If procAddress = 0 Then
MsgBox "Error getting procedure address" & vbCrLf & ErrorText(Err.LastDllError)
Exit Sub
End If
' Finally, call the procedure
CallWindowProc procAddress, 0&, "Dummy message", ByVal 0&, ByVal 0&
End Sub
' Gets the error message for a Windows error code
Private Function ErrorText(errorCode As Long) As String
Dim errorMessage As String
Dim result As Long
errorMessage = Space$(256)
result = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, errorCode, 0&, errorMessage, Len(errorMessage), 0&)
If result > 0 Then
ErrorText = Left$(errorMessage, result)
Else
ErrorText = "Unknown error"
End If
End Function
The .dll must be in the current "working" directory (or registered), otherwise at run-time the application can't find it.
Do:
MsgBox "The current directory is " & CurDir
And then compare that with what you were expecting. The .dll would need to be in that directory.
My standard first go-to approach to this issue is to break out ProcMon (or FileMon on XP). Setup the filters so that you can see where exactly it's searching for the file. It is possible that it's looking for the file elsewhere or for a different file name.
Private Declare Sub MYFUNC Lib "mylib.dll" ()
Firstly you are declaring a Sub, not a function.
These don't have return values:
(vb6) Sub() == (vc++) void Sub()
(vb6) Func() as string == (vc++) string Func()
The path you have declared is local to the running environment. Thus when running is debug mode using VB6.exe, you'll need to have mylib.dll in the same directory as VB6.exe.
As you are using private declare, you might want to consider a wrapper class for your dll. This allows you to group common dll access together but allowing for reuse. Then methods of the class are used to access the exposed function.
So you can use all the code provided above, copy it into a class
MyClass code:
Option Explicit
'Private Declare Sub MYFUNC Lib "mylib.dll" ()
'<all code above Main()>
Private Sub Class_Initialize()
'initialise objects
End Sub
Private Sub Class_Terminate()
'Set anyObj = Nothing
End Sub
Public Sub ClassMethod()
On Error Goto errClassMethod
'Perhaps look at refactoring the use of msgbox
'<code body from Main() given above>
exit sub
errClassMethod:
'handle any errors
End Sub
'<all code below main>
Apartment threading model loads ALL modules when the application is started. Using a class will only "load" the dll when the class is instantiated. Also results in neater calling code without the surrounding obfuscation of windows API calls: (ie. modMain):
Sub Main()
Dim m_base As MyClass
Set m_base = New MyClass
MyClass.ClassMethod()
End Sub
I tried #roomaroo's answer and it didn't give me specific enough info. Using Dependency Walker helped me resolve it. Also had to chdir, as per #bnadolson
I have a small VB6 app in which I use the Shell command to execute a program. I am storing the output of the program in a file. I am then reading this file and putting the output on the screen using a msgbox in VB6.
This is what my code looks like now:
sCommand = "\evaluate.exe<test.txt "
Shell ("cmd.exe /c" & App.Path & sCommand)
MsgBox Text2String(App.Path & "\experiments\" & genname & "\freq")
The problem is that the output which the VB program is printing using the msgbox is the old state of the file. Is there some way to hold the execution of the VB code until my shell command program finishes so that I get the correct state of the output file and not a previous state?
The secret sauce needed to do this is the WaitForSingleObject function, which blocks execution of your application's process until the specified process completes (or times out). It's part of the Windows API, easily called from a VB 6 application after adding the appropriate declaration to your code.
That declaration would look something like this:
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle _
As Long, ByVal dwMilliseconds As Long) As Long
It takes two parameters: a handle to the process that you want to wait on, and the time-out interval (in milliseconds) that indicates the maximum amount of time that you want to wait. If you do not specify a time-out interval (a value of zero), the function does not wait and returns immediately. If you specify an infinite time-out interval, the function returns only when the process signals that it has completed.
Armed with that knowledge, the only task that remains is figuring out how to get a handle to the process that you started. That turns out to be pretty simple, and can be accomplished a number of different ways:
One possibility (and the way I'd do it) is by using the ShellExecuteEx function, also from the Windows API, as a drop-in replacement for the Shell function that is built into VB 6. This version is far more versatile and powerful, yet just as easily called using the appropriate declaration.
It returns a handle to the process that it creates. All you have to do is pass that handle to the WaitForSingleObject function as the hHandle parameter, and you're in business. Execution of your application will be blocked (suspended) until the process that you've called terminates.
Another possibility is to use the CreateProcess function (once again, from the Windows API). This function creates a new process and its primary thread in the same security context as the calling process (i.e., your VB 6 application).
Microsoft has published a knowledge base article detailing this approach that even provides a complete sample implementation. You can find that article here: How To Use a 32-Bit Application to Determine When a Shelled Process Ends.
Finally, perhaps the simplest approach yet is to take advantage of the fact that the built-in Shell function's return value is an application task ID. This is a unique number that identifies the program you started, and it can be passed to the OpenProcess function to obtain a process handle that can be passed to the WaitForSingleObject function.
However, the simplicity of this approach does come at a cost. A very significant disadvantage is that it will cause your VB 6 application to become completely unresponsive. Because it will not be processing Windows messages, it will not respond to user interaction or even redraw the screen.
The good folks over at VBnet have made complete sample code available in the following article: WaitForSingleObject: Determine when a Shelled App has Ended.
I'd love to be able to reproduce the code here to help stave off link rot (VB 6 is getting up there in years now; there's no guarantee that these resources will be around forever), but the distribution license in the code itself appears to explicitly forbid that.
There is no need to resort to the extra effort of calling CreateProcess(), etc. This more or less duplicates the old Randy Birch code though it wasn't based on his example. There are only so many ways to skin a cat.
Here we have a prepackaged Function for handy use, which also returns the exit code. Drop it into a static (.BAS) module or include it inline in a Form or Class.
Option Explicit
Private Const INFINITE = &HFFFFFFFF&
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
lpExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Public Function ShellSync( _
ByVal PathName As String, _
ByVal WindowStyle As VbAppWinStyle) As Long
'Shell and wait. Return exit code result, raise an
'exception on any error.
Dim lngPid As Long
Dim lngHandle As Long
Dim lngExitCode As Long
lngPid = Shell(PathName, WindowStyle)
If lngPid <> 0 Then
lngHandle = OpenProcess(SYNCHRONIZE _
Or PROCESS_QUERY_INFORMATION, 0, lngPid)
If lngHandle <> 0 Then
WaitForSingleObject lngHandle, INFINITE
If GetExitCodeProcess(lngHandle, lngExitCode) <> 0 Then
ShellSync = lngExitCode
CloseHandle lngHandle
Else
CloseHandle lngHandle
Err.Raise &H8004AA00, "ShellSync", _
"Failed to retrieve exit code, error " _
& CStr(Err.LastDllError)
End If
Else
Err.Raise &H8004AA01, "ShellSync", _
"Failed to open child process"
End If
Else
Err.Raise &H8004AA02, "ShellSync", _
"Failed to Shell child process"
End If
End Function
I know it's an old thread, but...
How about using the Windows Script Host's Run method? It has a bWaitOnReturn parameter.
object.Run (strCommand, [intWindowStyle], [bWaitOnReturn])
Set oShell = CreateObject("WSCript.shell")
oShell.run "cmd /C " & App.Path & sCommand, 0, True
intWindowStyle = 0, so cmd will be hidden
Do like this :
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
' Start the shelled application:
ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function
Sub Form_Click()
Dim retval As Long
retval = ExecCmd("notepad.exe")
MsgBox "Process Finished, Exit Code " & retval
End Sub
Reference : http://support.microsoft.com/kb/129796
Great code. Just one tiny little problem: you must declare in the ExecCmd (after Dim start As STARTUPINFO):
Dim ret as Long
You will get an error when trying to compile in VB6 if you don't.
But it works great :)
Kind regards
In my hands, the csaba solution hangs with intWindowStyle = 0, and never passes control back to VB. The only way out is to end process in taskmanager.
Setting intWindowStyle = 3 and closing the window manually passes control back
I've found a better & simpler solution:
Dim processID = Shell("C:/path/to/process.exe " + args
Dim p As Process = Process.GetProcessById(processID)
p.WaitForExit()
and then you just continue with your code.
Hope it helps ;-)
How do you write a callback function in VB6? I know AddressOf gets you the function gets the address in a Long. But how do I call the function with the memory address? Thanks!
This post on vbforums.com gives an example of how to use AddressOf and the CallWindowProc function to execute a callback procedure.
Code from the post:
Private Declare Function CallWindowProc _
Lib "user32.dll" 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 Sub ShowMessage( _
msg As String, _
ByVal nUnused1 As Long, _
ByVal nUnused2 As Long, _
ByVal nUnused3 As Long)
'This is the Sub we will call by address
'it only use one argument but we need to pull the others
'from the stack, so they are just declared as Long values
MsgBox msg
End Sub
Private Function ProcPtr(ByVal nAddress As Long) As Long
'Just return the address we just got
ProcPtr = nAddress
End Function
Public Sub YouCantDoThisInVB()
Dim sMessage As String
Dim nSubAddress As Long
'This message will be passed to our Sub as an argument
sMessage = InputBox("Please input a short message")
'Get the address to the sub we are going to call
nSubAddress = ProcPtr(AddressOf ShowMessage)
'Do the magic!
CallWindowProc nSubAddress, VarPtr(sMessage), 0&, 0&, 0&
End Sub
I'm not sure exactly what you're trying to do.
To invert control, just create the callback function in a class. Then use an instance of the class (an object) to make the callback.
If you need to switch between different routines at run time, have separate classes that implement the same interface - a strategy pattern.
IMHO AddressOf is far too complicated and risky to use in this way.
AddressOf should only be used if you need to register callback functions with the Windows API.