Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
	(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
	ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
	Any, Source As Any, ByVal numBytes As Long)
Private 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 Any, lpcbData As Long) As Long

Const KEY_READ = &H20019
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const ERROR_MORE_DATA = 234
Public COMs(1 To 20, 0 To 2) As Variant     'Matriz que conterá os dados das seriais (COM1,COM2,...)
Public NumCOMs As Byte                      'Número de seriais encontradas



Function EnumRegistryValuesEx(ByVal hKey As Long, ByVal KeyName As String) As Boolean

	'Enumera as portas seriais com seus valores na matriz COMs, onde a primeira
	'dimensão indica cada porta serial das NumCOMs encontradas e a segunda dimensão
	'é composta de 3 elementos (Variant) onde COMs(i,0) é o nome do valor,
	'COMs(i,1) é o valor do valor e COMs(i,2) é o tipo do tipo de dado.
	'Exemplo de uso:

	'Const HKEY_LOCAL_MACHINE = &H80000002
	'.
	'.
	'.
    'If EnumRegistryValuesEx(HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM") Then
        'For i = 1 To NumCOMs
            'Com.AddItem COMs(i, 1)
        'Next i
        'Else
            'MsgBox "RegOpenKeyEx Failed", , "ERROR"
    'End If

    Dim handle As Long
    Dim index As Long
    Dim valueType As Long
    Dim name As String
    Dim nameLen As Long
    Dim resLong As Long
    Dim resString As String
    Dim dataLen As Long
    Dim valueInfo(0 To 2) As Variant
    Dim retVal As Long

    If Len(KeyName) Then
        If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
            EnumRegistryValuesEx = False
            Exit Function
        Else
            hKey = handle
        End If
    End If
    NumCOMs = 0
    Do
        nameLen = 260
        name = Space$(nameLen)
        dataLen = 4096
        ReDim resBinary(0 To dataLen - 1) As Byte
        retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&, valueType, resBinary(0), dataLen)
        If retVal = ERROR_MORE_DATA Then
			ReDim resBinary(0 To dataLen - 1) As Byte
			retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&, valueType, resBinary(0), dataLen)
        End If
        If retVal Then Exit Do
        NumCOMs = NumCOMs + 1
        valueInfo(0) = Left$(name, nameLen)
        Select Case valueType
			Case REG_DWORD
				CopyMemory resLong, resBinary(0), 4
				valueInfo(1) = resLong
				valueInfo(2) = vbLong
			Case REG_SZ, REG_EXPAND_SZ
				resString = Space$(dataLen - 1)
				CopyMemory ByVal resString, resBinary(0), dataLen - 1
				valueInfo(1) = resString
				valueInfo(2) = vbString
			Case REG_BINARY
				If dataLen < UBound(resBinary) + 1 Then
					ReDim Preserve resBinary(0 To dataLen - 1) As Byte
				End If
				valueInfo(1) = resBinary()
				valueInfo(2) = vbArray + vbByte
			Case REG_MULTI_SZ
				resString = Space$(dataLen - 2)
				CopyMemory ByVal resString, resBinary(0), dataLen - 2
				valueInfo(1) = resString
				valueInfo(2) = vbString
			Case Else
        End Select
        COMs(NumCOMs, 0) = valueInfo(0)
        COMs(NumCOMs, 1) = valueInfo(1)
        COMs(NumCOMs, 2) = valueInfo(2)
        index = index + 1
    Loop
    If handle Then RegCloseKey handle
    EnumRegistryValuesEx = True
End Function