我想做一个串口通讯，查看串口，请帮忙

Question

枚举注册表下的值：
HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM
，用API也行，但他会列出所有的端口（包括并口）。
【VB声明】
  Private Declare Function EnumPorts Lib "winspool.drv" Alias "EnumPortsA" (ByVal pName As String, ByVal Level As Long, ByVal lpbPorts As Long, ByVal cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long【别名】
  EnumPortsA【说明】
  枚举一个系统可用的端口 【返回值】
  Long，非零表示成功，零表示失败。会设置GetLastError 【备注】
  参考AddPort函数，了解进一步的情况【参数表】
  pName ----------  String，指定服务器的名字。用vbNullString指定本地系统  Level ----------  Long，1或2（1用于NT 3.51），分别指定PORT_INFO_1 或 PORT_INFO_2  lpbPorts -------  Long，包含PORT_INFO_1 或 PORT_INFO_2结构的缓冲区  cbBuf ----------  Long，lpbPorts缓冲区中的字符数量  pcbNeeded ------  Long，指向一个Long型变量的指针，该变量用于保存请求的缓冲区长度，或者实际读入的字节数量  pcReturned -----  Long，载入缓冲区的结构数量（用于那些能返回多个结构的函数）'==============================================
Private Type PORT_INFO_2
    pPortName As String
    pMonitorName As String
    pDescription As String
    fPortType As Long
    Reserved As Long
End Type
Private Type API_PORT_INFO_2
    pPortName As Long
    pMonitorName As Long
    pDescription As Long
    fPortType As Long
    Reserved As Long
End Type
Private Declare Function EnumPorts Lib "winspool.drv" Alias "EnumPortsA" (ByVal pName As String, ByVal Level As Long, ByVal lpbPorts As Long, ByVal cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Dim Ports(0 To 100) As PORT_INFO_2
Public Function TrimStr(strName As String) As String
    'Finds a null then trims the string
    Dim x As Integer
    x = InStr(strName, vbNullChar)
    If x > 0 Then TrimStr = Left(strName, x - 1) Else TrimStr = strName
End Function
Public Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
    Dim lngLength As Long
    'Get number of characters in string
    lngLength = lstrlenW(lngPointer) * 2
    'Initialize string so we have something to copy the string into
    LPSTRtoSTRING = String(lngLength, 0)
    'Copy the string
    CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
    'Convert to Unicode
    LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
End Function
'Use ServerName to specify the name of a Remote Workstation I.e. "//WIN95WKST"
'or leave it blank "" to get the ports of the local Machine
Public Function GetAvailablePorts(ServerName As String) As Long
    Dim ret As Long
    Dim PortsStruct(0 To 100) As API_PORT_INFO_2
    Dim pcbNeeded As Long
    Dim pcReturned As Long
    Dim TempBuff As Long
    Dim I As Integer
    'Get the amount of bytes needed to contain the data returned by the API call
    ret = EnumPorts(ServerName, 2, TempBuff, 0, pcbNeeded, pcReturned)
    'Allocate the Buffer
    TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
    ret = EnumPorts(ServerName, 2, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
    If ret Then
        'Convert the returned String Pointer Values to VB String Type
        CopyMem PortsStruct(0), ByVal TempBuff, pcbNeeded
        For I = 0 To pcReturned - 1
            Ports(I).pDescription = LPSTRtoSTRING(PortsStruct(I).pDescription)
            Ports(I).pPortName = LPSTRtoSTRING(PortsStruct(I).pPortName)
            Ports(I).pMonitorName = LPSTRtoSTRING(PortsStruct(I).pMonitorName)
            Ports(I).fPortType = PortsStruct(I).fPortType
        Next
    End If
    GetAvailablePorts = pcReturned
    'Free the Heap Space allocated for the Buffer
    If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff
End Function
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    Dim NumPorts As Long
    Dim I As Integer
    'Get the Numbers of Ports in the System
    'and Fill the Ports Structure
    NumPorts = GetAvailablePorts("")
    'Show the available Ports
    Me.AutoRedraw = True
    For I = 0 To NumPorts - 1
        Me.Print Ports(I).pPortName
    Next
End Sub

Answer 1

Public Declare Function CommConfigDialog Lib "kernel32" Alias "CommConfigDialogA" (ByVal lpszName As String, ByVal hWnd As Long, lpCC As COMMCONFIG) As LongPrivate Sub Command1_Click()
Dim comm As COMMCONFIG
comm.dwSize = 10000
Debug.Print comm.dwSize
CommConfigDialog "COM1", Me.hWnd, comm
Debug.Print comm.dwSize
End Sub

Answer 2

CreateFile、ReadFild、WriteFile、WaitCommEvent、SetupCommSetCommStat、BuildCommDCB、SetCommMask、GetCommState、ClearCommErrorCommConfigDialog、PurgeComm………………

Answer 3

感谢 daviddivad，
   我测试了你的程序，但与我的想像还有一点距离，我要找的是可用的COM口，我的本机能用的COM口是COM1但它出现了COM1到COM4以及FILE，LPT1到LPT4。 mazhayang(蚂蚱先生)：
  我好像不能使用你的程序，COMMCONFIG如何定义，还请帮忙。
 我想的是与windows的超级终端一样的功能，所列出的COM口必须能进行COM通讯，有人有方法吗？

Answer 4

MSCOMM无法提供一个检查可用端口的方法，我也试过使用错误处理，可是好像不是十分的好，WINDOWS对超级终端肯定提供了相应的API，如TAPI的lineTranslateDialog.有人对此有了解吗？

Answer 5

枚举注册表下的值：
HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM
这个说法好像可行，可怎么做？

Answer 6

临时写了个例子，你新建一个工程，把以下代码复制进去就行了，该程序连MODEM的端口都检测出来了，你可根据你的要求把它去掉也行。WIN2000+VB6+SP5 测试通过。Option ExplicitConst HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) 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 Byte, lpcbData As Long) As Long
Private 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
Private Sub Form_Paint()
    Dim hKey As Long, Cnt As Long, sSave As String
    Dim strRet As String
    Dim lRet As Long
    Me.Cls
    Me.Print "RegEnumValue:"
    RegOpenKey HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM", hKey
    Cnt = 0
    Do
        sSave = String(255, 0)
        If RegEnumValue(hKey, Cnt, sSave, 255, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
        strRet = StripTerminator(sSave)
        Me.Print strRet & vbTab;
        sSave = String(255, 0)
        If RegQueryValueEx(hKey, strRet, 0, REG_SZ, ByVal sSave, 255) = 0 Then
            strRet = StripTerminator(sSave)
            Me.Print strRet
        End If
        Cnt = Cnt + 1
    Loop
    RegCloseKey hKey
End Sub
Private Function StripTerminator(sInput As String) As String
    Dim ZeroPos As Integer
    ZeroPos = InStr(1, sInput, vbNullChar)
    If ZeroPos > 0 Then
        StripTerminator = Left$(sInput, ZeroPos - 1)
    Else
        StripTerminator = sInput
    End If
End Function

Answer 7

谢谢，太感谢了。
我还有一个问题，我想调用WINDOWS的配置窗口，可以吗？不行只好自己写了。