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.
Related
I've searched, and can't seem to find an answer, so any help would be appreciated.
I want to make a hotkey, but when the hotkey is pressed, I don't want the actual "character" to be displayed, just the action to be performed.
So for example, I have this:
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As KeyCodeConstants) As Long
Private Const VK_A = &H41
Private Sub keyboardTimer001_Timer()
If KeyDown(VK_A) Then
' do my stuff, but DONT DISPLAY the letter "A"
End If
end sub
So this basically just has a timer (interval 1) checking the async keyboard. If it detects that the letter "a" was pressed, I perform an action. But I want it to do this WITHOUT printing the letter "a".
How would I remove the key from the keyboard buffer/prevent it from displaying? (Side note - not sure if something like 'PeekMessage' would work - if so - does anyone know where I can find a good vb6 code sample where I can peek for stuff like 'ctrl+a' or 'ctrl+alt+a', etc, etc and then just clear the buffer, and perform my action?)
Thanks!
You can use a combination of RegisterHotKey and PeekMessage. The following code defines Key-A and Ctrl-A to perform actions:
Main Form
Option Explicit
Private Done As Boolean
Private Sub Form_Activate()
Done = False
RegisterHotKey Me.hWnd, &HBBBB&, MOD_NONE, vbKeyA
RegisterHotKey Me.hWnd, &HBBBA&, MOD_CONTROL, vbKeyA
ProcessMessages
End Sub
Private Sub ProcessMessages()
Dim Message As Msg
Do While Not Done
WaitMessage
If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
If Message.wParam = &HBBBB& Then
MsgBox "This is my Key-A action"
ElseIf Message.wParam = &HBBBA& Then
MsgBox "This is my Ctrl-A action"
End If
End If
DoEvents
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
Done = True
Call UnregisterHotKey(Me.hWnd, &HBBBB&)
Call UnregisterHotKey(Me.hWnd, &HBBBA&)
End Sub
The above code works well, but in a production app I might lean towards subclassing the main window. If you prefer subclassing, you will need to use a technique of your choosing and replace the ProcessMessages method with something like this:
Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_HOTKEY
If wParam = &HBBBB& Then
MsgBox "This is my Key-A action"
ElseIf wParam = &HBBBA& Then
MsgBox "This is my Ctrl-A action"
End If
End Select
End Function
As you can see, subclassing is a little cleaner. Of course, you need to define the Win API stuff. So in a module, place the following code:
Module
Option Explicit
Public Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Public Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Public Declare Function WaitMessage Lib "user32" () As Long
Public Const MOD_NONE = &H0
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const MOD_WIN = &H8
Public Const PM_REMOVE = &H1
Public Const WM_HOTKEY = &H312
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type Msg
hWnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
I am loading OCX dynamically in VB 6.0.
The following is the code that I am using to load and call the methods:
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 Sub Foo
On Error Resume Next
Dim lb As Long, pa As Long
Dim versionString As String
Dim retValue as Long
lb = LoadLibrary("D:\projects\other\VB_DLLs\TestDLL\TestDLL.dll")
'retrieve the address of getVersion'
pa = GetProcAddress(lb, "getVersion")
'Call the getVersion function'
retValue = CallWindowProc (pa, Me.hWnd, "I want my version", ByVal 0&, ByVal 0&)
'release the library'
FreeLibrary lb
End Sub
Now I want to access public properties of OCX. How I can access (get/set) the properties of OCX?
You can not use an OCX/COM control in that manner.
To create and use an instance of the object, you will need to.. create an instance of the object, then use that.
Set TestObject = CreateObject("TestDll.TestObject")
Value = TestObject.Method(InputValue)
This requires the DLL to be registered, and will use whichever is registered rather than a specific instance.
If you don't want it to be registered, look at DirectCOM.
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.
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 ;-)
I have a need to create a wrapper for a DLL, loading and unloading it as needed (for those interested in the background of this question, see How to work around memory-leaking 3rd party DLL (no source code) accessed by Tomcat application?) . I'm doing it in Visual Basic 6, and the loading and unloading with the following example works:
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 Sub cmdTestLoadingDLL_Click()
Dim lb As Long, pa As Long
lb = LoadLibrary("D:\projects\other\VB_DLLs\TestDLL\TestDLL.dll")
Msgbox "Library address: " + lb
FreeLibrary lb
End Sub
I can see using Process Explorer that the DLL is loaded to memory when the messagebox is displayed, and is discarded afterwards. However, calling the method is naturally not enough - I need to access the methods within the dynamically loaded DLL.
How can I achieve this? I would like to call the method getVersion in class mainClass, which is in TestDLL, like this:
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 Sub cmdTestLoadingDLL_Click()
Dim lb As Long, pa As Long
Dim versionString As String
lb = LoadLibrary("D:\projects\other\VB_DLLs\TestDLL\TestDLL.dll")
versionString = "- From DLL: " + mainClass.getVersion
MsgBox versionString
FreeLibrary lb
End Sub
However, the line
versionString = "- From DLL: " + mainClass.getVersion
throws an error "Object required".
First of all, since you are calling it via LoadLibrary, there are no classes here - only functions are exported for public consumption. So your mainClass reference would never work. Let's assume you have a function getVersion that is exported.
I would try the following:
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 Sub Foo
On Error Resume Next
Dim lb As Long, pa As Long
Dim versionString As String
Dim retValue as Long
lb = LoadLibrary("D:\projects\other\VB_DLLs\TestDLL\TestDLL.dll")
'retrieve the address of getVersion'
pa = GetProcAddress(lb, "getVersion")
'Call the getVersion function'
retValue = CallWindowProc (pa, Me.hWnd, "I want my version", ByVal 0&, ByVal 0&)
'release the library'
FreeLibrary lb
End Sub
Do you need to call COM methods on this DLL? If so, I'm not at all sure this is possible.
Matthew Curland's excellent Advanced Visual Basic 6 is the first place I'd look, though. There's some powerful under-the-hood COM stuff in there that circumvents the normal VB6 techniques.
There's also DirectCom, which allows you to call COM methods without using COM. Never used it myself, but people chat about it on the VB6 newsgroup.