Hi all,
I am devloping the dialer application in VB.In that I am facing one prob. that is I require the list of modems attached to a computer in a combo box.Any help in this is highly appreciated.
Thanx in Advance
Sachin...
Printable View
Hi all,
I am devloping the dialer application in VB.In that I am facing one prob. that is I require the list of modems attached to a computer in a combo box.Any help in this is highly appreciated.
Thanx in Advance
Sachin...
there is 2 way you can do it.
1. detect the DTR with your MSComm32.OCX control
2. Juz open all the available serial port, send a "AT" & vbCrLf command to the opened port and juz wait for the OK response from the modem. If you can get a OK, mean the modem is present, else modem is not attached to the specific port.
regards,
There is an easier way; all modems are stored in the registry...
Paste this into a module
Usage:VB Code:
Option Explicit Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_USERS = &H80000003 Public Const HKEY_PERFORMANCE_DATA = &H80000004 Public Const HKEY_CURRENT_CONFIG = &H80000005 Public Const HKEY_DYN_DATA = &H80000006 Public Const REG_SZ = 1 ' Unicode nul terminated string Public Const REG_BINARY = 3 ' Free form binary Public Const REG_DWORD = 4 ' 32-bit number Public Const ERROR_SUCCESS = 0& Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Public Function GetAllKeys(hKey As Long, strPath As String) As Variant ' Returns: an array in a variant of strings Dim lRegResult As Long Dim lCounter As Long Dim hCurKey As Long Dim strBuffer As String Dim lDataBufferSize As Long Dim strNames() As String Dim intZeroPos As Integer lCounter = 0 lRegResult = RegOpenKey(hKey, strPath, hCurKey) Do 'initialise buffers (longest possible length=255) lDataBufferSize = 255 strBuffer = String(lDataBufferSize, " ") lRegResult = RegEnumKey(hCurKey, lCounter, strBuffer, lDataBufferSize) If lRegResult = ERROR_SUCCESS Then 'tidy up string and save it ReDim Preserve strNames(lCounter) As String intZeroPos = InStr(strBuffer, Chr$(0)) If intZeroPos > 0 Then strNames(UBound(strNames)) = Left$(strBuffer, intZeroPos - 1) Else strNames(UBound(strNames)) = strBuffer End If lCounter = lCounter + 1 Else Exit Do End If Loop GetAllKeys = strNames End Function Public Function GetSettingString(hKey As Long, strPath As String, strValue As String, Optional Default As String) As String Dim hCurKey As Long Dim lValueType As Long Dim strBuffer As String Dim lDataBufferSize As Long Dim intZeroPos As Integer Dim lRegResult As Long ' Set up default value If Not IsEmpty(Default) Then GetSettingString = Default Else GetSettingString = "" End If ' Open the key and get length of string lRegResult = RegOpenKey(hKey, strPath, hCurKey) lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize) If lRegResult = ERROR_SUCCESS Then If lValueType = REG_SZ Then ' initialise string buffer and retrieve string strBuffer = String(lDataBufferSize, " ") lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize) ' format string intZeroPos = InStr(strBuffer, Chr$(0)) If intZeroPos > 0 Then GetSettingString = Left$(strBuffer, intZeroPos - 1) Else GetSettingString = strBuffer End If End If Else ' there is a problem End If lRegResult = RegCloseKey(hCurKey) End Function
VB Code:
Dim SubKeys As Variant Dim KeyLoop As Integer Dim KeyName As String Dim FullName As String SubKeys = GetAllKeys(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\Modem") ' Get Full names of all modems installed and put in user select box If VarType(SubKeys) = vbArray + vbString Then For KeyLoop = 0 To UBound(SubKeys) KeyName = SubKeys(KeyLoop) FullName = GetSettingString(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\Class\Modem\" & KeyName, "DriverDesc") Combo1.AddItem FullName Next End If
If you would rather use the API instead of accessing the registry, which is what a lot of API calls do anyways, look into TAPI. It is alive and well in Windows.
chrisjk, I have Win XP (SP1) with a two modems, and those registry entries does not even exists on me system. Are the paths different for different OS'es (i.e. 98 / NT 4.0)?
Try something like this:
In a Standard Module:Example Usage:VB Code:
Option Explicit Private Const RAS_MaxDeviceType = 16 Private Const RAS_MaxDeviceName = 128 Private Const GMEM_FIXED = &H0 Private Const GMEM_ZEROINIT = &H40 Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT) Private Const APINULL = 0& Private Type RASDEVINFO dwSize As Long szDeviceType(RAS_MaxDeviceType) As Byte szDeviceName(RAS_MaxDeviceName) As Byte End Type Private Declare Function RasEnumDevices Lib "rasapi32.dll" Alias "RasEnumDevicesA" (lpRasDevInfo As Any, lpcb As Long, lpcDevices As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long Public Function GetRASDeviceList() As String() Dim sList() As String Dim tRasDevInfo As RASDEVINFO Dim lCb As Long Dim lDevices As Long Dim lBuff As Long Dim lRet As Long Dim lPtr As Long Dim lCount As Long lCb = 0 tRasDevInfo.dwSize = LenB(tRasDevInfo) + (LenB(tRasDevInfo) Mod 4) lRet = RasEnumDevices(ByVal 0, lCb, lDevices) lBuff = GlobalAlloc(GPTR, lCb) CopyMemory ByVal lBuff, tRasDevInfo, LenB(tRasDevInfo) lRet = RasEnumDevices(ByVal lBuff, lCb, lCb) If lRet = 0 Then lPtr = lBuff Do While lDevices > 0 CopyMemory tRasDevInfo, ByVal lPtr, LenB(tRasDevInfo) If StrComp(ByteToString(tRasDevInfo.szDeviceType), "Modem", vbTextCompare) = 0 Then ReDim Preserve sList(lCount) sList(lCount) = ByteToString(tRasDevInfo.szDeviceName) lCount = lCount + 1 End If lPtr = lPtr + LenB(tRasDevInfo) + (LenB(tRasDevInfo) Mod 4) lDevices = lDevices - 1 Loop End If If lBuff <> 0 Then GlobalFree (lBuff) GetRASDeviceList = sList End Function Private Function ByteToString(ByRef bByte() As Byte) As String Dim lCount As Long Dim sString As String Do While lCount < UBound(bByte) And bByte(lCount) <> 0 sString = sString & Chr$(bByte(lCount)) lCount = lCount + 1 Loop ByteToString = sString End FunctionVB Code:
Private Sub Form_Load() Dim sList() As String Dim lCount As Long sList = GetRASDeviceList() For lCount = 0 To UBound(sList) List1.AddItem sList(lCount) Next End Sub