|
|
Posted by Steve on 04/25/07 13:14
this code will allow you to enum all the com ports on your windows machine
(fix the text-wrapping):
=============
Option Explicit
'================================================================================================
Private Const mcstrRegKeyPorts As String * 29 =
"HARDWARE\DEVICEMAP\SERIALCOMM"
'================================================================================================
Public Const CB_FINDSTRINGEXACT As Long = &H158
Public Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Const KEY_QUERY_VALUE As Long = &H1
Public Const MAX_PATH As Long = 255
Public Const REG_SZ As Long = 1
'================================================================================================
Public Declare Sub Copy Lib "kernel32.dll" Alias "RtlMoveMemory"
(Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal lngHKey As
Long) As Long
Public Declare Function RegEnumValue Lib "advapi32.dll" Alias
"RegEnumValueA" (ByVal hkey As Long, ByVal dwIndex As Long, ByVal
lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long,
lpType As Long, lpData As Byte, lpcbData As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" (ByVal lngHKey As Long, ByVal lpSubKey As String, ByVal
ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As
Long
Public Declare Function ShowComSettings Lib "winspool.drv" Alias
"ConfigurePortA" (ByVal pName As String, ByVal hWnd As Long, ByVal pPortName
As String) As Long
'================================================================================================
Public Function ComPorts() As String()
Dim lngHKey As Long
Dim lngPtr As Long
Dim lngReturn As Long
Dim strKeyName As String
Dim lngKeyLen As Long
Dim bytKeyValue(0 To 254) As Byte
Dim lngKeyValueLen As Long
Dim lngDataType As Long
Dim strValue As String
Dim strDefinedPorts() As String
lngReturn = RegOpenKeyEx(HKEY_LOCAL_MACHINE, mcstrRegKeyPorts, 0,
KEY_QUERY_VALUE, lngHKey)
If lngReturn <> 0 Then Exit Function
While lngReturn = 0
strKeyName = Space(MAX_PATH)
lngKeyLen = Len(strKeyName)
lngKeyValueLen = lngKeyLen
lngReturn = RegEnumValue(lngHKey, _
lngPtr, _
strKeyName, _
lngKeyLen, _
0&, _
lngDataType, _
bytKeyValue(0), _
lngKeyValueLen)
If lngReturn = 0 Then
strKeyName = Left$(strKeyName, lngKeyLen)
lngKeyValueLen = lngKeyValueLen - 1
strValue = Space(lngKeyValueLen)
Copy ByVal strValue, bytKeyValue(0), lngKeyValueLen
ReDim Preserve strDefinedPorts(lngPtr)
strDefinedPorts(lngPtr) = strValue
lngPtr = lngPtr + 1
End If
Wend
RegCloseKey lngHKey
Sort strDefinedPorts, LBound(strDefinedPorts), UBound(strDefinedPorts)
ComPorts = strDefinedPorts
End Function
Private Function Sort(ByRef strArray() As String, intStartPtr As Integer,
intEndPtr As Integer)
Dim intLow As Integer
Dim intHigh As Integer
Dim strElement As String
intLow = intStartPtr
intHigh = intEndPtr
strElement = strArray((intStartPtr + intEndPtr) / 2)
While (intLow <= intHigh)
While (strArray(intLow) < strElement And intLow < intEndPtr)
intLow = intLow + 1
Wend
While (strElement < strArray(intHigh) And intHigh > intStartPtr)
intHigh = intHigh - 1
Wend
If (intLow <= intHigh) Then
strElement = strArray(intLow)
strArray(intLow) = strArray(intHigh)
strArray(intHigh) = strElement
intLow = intLow + 1
intHigh = intHigh - intHigh
End If
Wend
If (intStartPtr < intHigh) Then Sort strArray, intStartPtr, intHigh
If (intLow < intEndPtr) Then Sort strArray, intLow, intEndPtr
End Function
[Back to original message]
|