本帖最后由 aqq886_88 于 2014-09-20 21:50:43 编辑

解决方案 »

  1.   

    使用系统 API :
    Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As LongPublic Declare Function ReadFile Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As LongPublic Declare Function WriteFile Lib "kernel32" Alias "WriteFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As LongPublic Declare Function CloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As Long
      

  2.   

        lngRes = SetupDiClassGuidsFromName("Ports", objGuid.Data(0), 1, dwSize)                 '获取类名为"Ports"的GUID
        hDevInfo = SetupDiGetClassDevs(VarPtr(objGuid), 0, 0, DIGCF_PRESENT Or DIGCF_PROFILE)   '根据串口GUID获取设备句柄
        objSpdd.cbSize = Len(objSpdd)
        Do While 1
            lngRes = SetupDiEnumDeviceInfo(hDevInfo, dwIndex, objSpdd)  '根据设备句柄检举包含的设备
            If lngRes = 0 Then Exit Do                                  '检举返回无效则退出检举
            
            lngRes = SetupDiGetDeviceRegistryProperty(hDevInfo, objSpdd, SPDRP_FRIENDLYNAME, 0, 0&, 0, dwSize)   '根据dwIndex设备句柄请求FRIENDLYNAME访问
            If dwSize <= 0 Then GoTo exitFunction                        '设备无FRIENDLYNAME属性则结束函数
            ReDim buffer(dwSize)
            lngRes = SetupDiGetDeviceRegistryProperty(hDevInfo, objSpdd, SPDRP_FRIENDLYNAME, 0, VarPtr(buffer(0)), dwSize, dwSize)    '根据返回的FRIENDLYNAME信息指针获取dwIndex设备的FRIENDLYNAME的内容
            lngDeviceNumber = StrConv(buffer, vbUnicode)                '整理得到的FRIENDLYNAME字符串
            lngDeviceNumber = Left(lngDeviceNumber, InStr(lngDeviceNumber, Chr(0)) - 1)
            
            hKey = SetupDiOpenDevRegKey(hDevInfo, objSpdd, &H1, 0&, &H1, &H1)               '打开设备指定的注册表
            If hKey Then
                szPortName = Space(255)
                lngRes = RegQueryValueEx(hKey, "PortName", 0, &H80000000, szPortName, 1024) '获取串口设备PortName的键值
                RegCloseKey (hKey)
                If lngRes = 0 Then szPortName = Left(szPortName, InStr(szPortName, Chr(0)) - 1) Else szPortName = "Err " '整理得到的PortName字符串
            End If
            
            dwIndex = dwIndex + 1
            GetSerialPort = GetSerialPort & "PortName: " & szPortName & vbTab & "-> FriendlyName: " & lngDeviceNumber & vbCrLf
        Loop
    以前弄的测试过是可以的,觉得挺麻烦的。
    需要很多API:Private Declare Function SetupDiGetClassDevs Lib "setupapi.dll" Alias "SetupDiGetClassDevsA" (ByVal ClassGuid As Long, ByVal Enumerator As Long, ByVal HwndParent As Long, ByVal Flags As Long) As Long
    Private Declare Function SetupDiEnumDeviceInfo Lib "setupapi.dll" (ByVal DeviceInfoSet As Long, ByVal MemberIndex As Long, ByRef deviceInfoData As SP_DEVINFO_DATA) As Boolean
    Private Declare Function SetupDiDestroyDeviceInfoList Lib "setupapi.dll" (ByVal DeviceInfoSet As Long) As Long
    Private Declare Function SetupDiGetDeviceRegistryProperty Lib "setupapi" Alias "SetupDiGetDeviceRegistryPropertyA" (ByVal DeviceInfoSet As Long, deviceInfoData As SP_DEVINFO_DATA, ByVal Property As Long, ByRef PropertyRegDataType As Long, ByVal PropertyBuffer As Long, ByVal PropertyBufferSize As Long, RequiredSize As Long) As Long
    Private Declare Function SetupDiClassGuidsFromName Lib "setupapi.dll" Alias "SetupDiClassGuidsFromNameA" (ByVal ClassName As String, ClassGuidList As Long, ByVal ClassGuidListSize As Long, RequiredSize As Long) As Boolean
    Private Declare Function SetupDiOpenDevRegKey Lib "setupapi.dll" (ByVal hDeviceInfo As Long, ByRef deviceInfoData As SP_DEVINFO_DATA, ByVal Scope As Long, ByVal hwprofile As Integer, ByVal parameterRegistryValueKind As Long, ByVal samDesired 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, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hHey As Long) As Long
      

  3.   

    枚举注册表呗。
        result = RegOpenKeyEx( HKEY_LOCAL_MACHINE,
    _T( "Hardware\\DeviceMap\\SerialComm" ),
    NULL,
    KEY_READ,
    &hkey );
      

  4.   

    如果枚举注册表到相应的端口,却如何去打开这个端口呢,VB自带的MSCOMM好打开吗
      

  5.   

    使用系统的 API 函数。MSCOMM 只能打开 16 个。
      

  6.   

    在”设备管理“里面的串口,并口管理中,可以修稿USB虚拟出来的串口的编号,比如修稿com20为com1。这是一种解决办法。
    用API相当于自己写个mscomm了,也是一个解决办法。