sendmessage not working for jetaudio in vb6 - vb6

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.

Related

Detecting a Keypress outside Vb6

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

GetWindowText does not work

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

Performing a KeyDown function without focus in Visual Basic

It's quite simple really. I want for an application to keep monitoring KeyDown events even without focus.
Private Sub Form1_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
Select Case e.KeyData
Case Keys.MediaStop
PictureBox2_Click(sender, e)
Case Keys.MediaPlayPause
PauseToolStripMenuItem_Click(sender, e)
Case Keys.MediaNextTrack
SkipTrackToolStripMenuItem_Click(sender, e)
Case Keys.MediaPreviousTrack
PreviousTrackToolStripMenuItem_Click(sender, e)
End Select
End Sub
The above code is for a music player. Functions are called when the media keys are pressed ('Fn'+ 'Home', 'Fn' + 'Pg Up'...etc)
In a previous comment, somebody suggested looking into WH_KEYBOARD_LL for a solution but I didn't really understand much of it, if I'm honest.
UPDATE:
The link suggested isn't great as the 'As Any' keyword is not supported in 'Declare' functions.
This is how far I've got with it...
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 Const HC_ACTION = 0
Structure HookStruct
Dim vkCode As Long
Dim scancode As Long
Dim flags As Long
Dim time As Long
Dim dwExtraInfo As Long
End Structure
The errors that Visual Studio is underlining are all written in bold
On hover of 'Any' it gives me the message "'As Any' is not supported in 'Declare' statements"
On hover of 'Global' it gives "Syntax error"
Implementing Keyboard hook using Windows API is the solution. Please check : http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=13506&lngWId=1
If you are using VB6 and want to Hide the Navigation Bar, simply do this.
aw$ = "^(h)"
SendKeys aw$
Apply this after pdf file loads.

Loading OCX dynamically in VB 6.0

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.

How to download multiple files in VB6 with progress bar?

I want to download multiple files (mostly images) from VB6 application. presently i m using URLDownloadToFile but it allows only one file at a time and there is no progress bar. I want to download multiple files and with progress bar. please help. thanks in advance.
my present code:
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
You want to download the file asynchronously, so that your VB code continues executing while the download happens. There is a little-known way to do this with native VB6, using the AsyncRead method of UserControl and UserDocument objects - no need for API calls.
Here's an excellent explanation and VB6 code for multiple simultaneous downloads, from the renowned VB6 guru Karl Peterson. The AsyncReadProgress event gives you the BytesRead and BytesMax, which will allow you to display a progress bar.
You're hoping for a VB answer, but this is non trivial.
Most of the following comes from http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_20571958.html
IBindStatusCallback interface is not
directly accessible from VB. It must
be introduced into a compatible type
library.
You can find the Type library
olelib.tlb under:
http://www.domaindlx.com/e_morcillo/scripts/type/default.asp
The zip file name to download is:
tl_ole.zip
You will also find examples on how to
use it included. Not sure thou whether
you will find a specific example on
IBindStatusCallback on not, but it
worth giving it a try.
You can write your own function to get the data into a string, which will give you full control over everything:
Option Explicit
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_DEFAULT_HTTP_PORT = 80
Public Const INTERNET_SERVICE_HTTP = 3
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const HTTP_QUERY_STATUS_CODE = 19
Public Const HTTP_ADDREQ_FLAG_ADD = &H20000000
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long
Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Long
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Integer
Public Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumberOfBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternet&, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength&, ByVal dwFlags&, ByVal dwContext&) As Long
Public Declare Function InternetQueryDataAvailable Lib "wininet.dll" (ByVal hFile As Long, lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Public Function GetHTML(strURL As String) As String
Const BufferSize = 16384
Dim hSession&, hURL&, lRet&, lBytesAvail&
Dim Buffer As String * BufferSize
Dim BufferLen&, sResult$
hSession = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
hURL = InternetOpenUrl(hSession, strURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
sResult = ""
Do
InternetReadFile hURL, Buffer, Len(Buffer), BufferLen
If BufferLen > 0 Then sResult = sResult & Left(Buffer, BufferLen)
Loop Until BufferLen = 0
GetHTML = sResult
InternetCloseHandle hURL
InternetCloseHandle hSession
End Function
You will find additional resources for doing the callback method here (scroll down to the bottom):
http://www.experts-exchange.com/Programming/Languages/.NET/Visual_Basic.NET/Q_21763861.html
http://www.experts-exchange.com/Programming/Languages/.NET/Visual_Basic.NET/Q_21746456.html
But I honestly think you'll be better off making your own download function if you want more control over it. TCP/IP stuff in VB is actually very easy.
-Adam

Resources