获得系统RS232串口个数的API

Question

获得系统RS232串口个数的API？
我现在VB中调用。这个API是什么？怎么在VB中调用

Answer 1

发段vc的
//***********************
// 枚举所有的串口，以及名称
//***********************
int
EnumAllComm( TCHAR *buf )
{
    HKEY hkey;  
    int result;
int i = 0; *buf = 0;    result = RegOpenKeyEx( HKEY_LOCAL_MACHINE,
_T( "Hardware\\DeviceMap\\SerialComm" ),
NULL,
KEY_READ,
&hkey ); if( ERROR_SUCCESS == result )   //   打开串口注册表   
{   
TCHAR portName[ 0x100 ], commName[ 0x100 ];
DWORD dwLong, dwSize; do
{   
dwSize = sizeof( portName ) / sizeof( TCHAR );
dwLong = dwSize;
result = RegEnumValue( hkey, i, portName, &dwLong, NULL, NULL, ( LPBYTE )commName, &dwSize );
if( ERROR_NO_MORE_ITEMS == result )
{
//   枚举串口
break;   //   commName就是串口名字
}
_tcscpy( buf, commName );
buf += ( _tcslen( buf ) + 1 );
i++;   
} while ( 1 ); RegCloseKey( hkey );   
}   *buf = 0; return i;
}

Answer 2

'*********************************读取注册表全部的串口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 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, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1
Dim ComStr$()
Private Sub Command1_Click()
   MsgBox GetAllPort
End SubPublic Function GetAllPort() As String
   On Error Resume Next
   S = GetSerialPort(HKEY_LOCAL_MACHINE, "HARDWARE\DEVICEMAP\SERIALCOMM")
   If ComStr(0) = "" Then Exit Function
   GetAllPort = ""
   For i = 0 To UBound(S)
      GetAllPort = GetAllPort & S(i) & ","
   Next i
End FunctionPublic Function GetSerialPort(RegAddr&, Items$) As String()
   On Error Resume Next
   Dim hKey&, S1$, S2$, L&, L1&
   RegOpenKey RegAddr, Items, hKey
   ReDim Preserve ComStr$(0)
   ComStr(0) = "": i = 0: J = 0: Rtn = 0
   Do
      L = 1000: L1 = 1000
      S1 = Space(L): S2 = Space(L)
      Rtn = RegEnumValue(hKey, i, S1, L, 0, REG_SZ, S2, L1)
      If Rtn = 0 Then
         If InStr(S1, Chr(0)) > 0 And InStr(S2, Chr(0)) > 0 Then
            S1 = UCase(Left(S1, InStr(S1, Chr(0)) - 1))
            S2 = UCase(Left(S2, InStr(S2, Chr(0)) - 1))
            If InStr(S2, "COM") > 0 Then
               ReDim Preserve ComStr$(J)
               ComStr(J) = S2
               J = J + 1
            End If
         End If
      End If
      i = i + 1
   Loop Until Rtn <> 0
   GetSerialPort = ComStr()
End Function

Answer 3

'用 DOS 枚举您的机器串口配置端口号'在DOS下运行必需使用短路径Option Explicit
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Dim AppDisk$, Fname$, aa$, t&
Private Sub Form_Load()
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   Me.AutoRedraw = True
   AppDisk = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
   AppDisk = GetShortName(AppDisk)
   Fname = AppDisk & "test.txt"
   If Dir(Fname) = "" Then
      Open Fname For Output As #1
      Close #1
   End If
End SubPrivate Sub Command1_Click()
   Call Shell("cmd /c mode >" & Fname, vbHide)
   Open Fname For Input As #1
   t = Timer
   Do: DoEvents: Loop Until Timer > t + 1
   While Not EOF(1)
      Line Input #1, aa
      If InStr(aa, "COM") > 0 Then Print aa
   Wend
   Close #1
End Sub
 
Public Function GetShortName(ByVal sLongFileName As String) As String
   On Error Resume Next
   Dim lRetVal&, sShortPathName$
   sShortPathName = Space(255)
   Call GetShortPathName(sLongFileName, sShortPathName, 255)
   If InStr(sShortPathName, Chr(0)) > 0 Then
      GetShortName = Mid(sShortPathName, 1, InStr(sShortPathName, Chr(0)) - 1)
   Else
      GetShortName = Trim(Mid(sShortPathName, 1))
   End If
End Function

Answer 4

有一个偏门方法，
使用API函数：CreateFile可以打开串口，如果成功打开那么返回值是：1，反之是：0 那么使用循环一个一个编号的操作，比如，连续打开了8个成功，第9个失败，那么就表示有8个串口。

Answer 5

   Dim POSTObj As Object
   Dim COMPost As Object
   Combo1.Clear
   Set POSTObj = WMIObj.InstancesOf("Win32_SerialPort")
   For Each COMPost In POSTObj
      '以下判断你的USB驱动名称进行识别
      Combo1.AddItem COMPost.Description & "(" & COMPost.DeviceID & ")"
      Combo1.ItemData(Combo1.ListCount - 1) = Int(Right(COMPost.DeviceID, Len(COMPost.DeviceID) - 3))
   Next
   Combo1.ListIndex = 0

Answer 6

以下方法同样能找出串口设备，不过需要自己加一下识别条件//********************************************************************************
//**   函 数 名 ： GetDeviceState
//**   输    入 ： DeviceName -  设备名称
//**   返    回 ： BOOL -  返回设备启用/禁用状态
//**   功能描述 ： 取得设备的启用或禁用状态
//********************************************************************************
long _stdcall GetDeviceState(char * DeviceName)
{
//------------------------------------------------
//              过程内局部变量定义
//------------------------------------------------
HDEVINFO hDevInfo;
SP_DEVINFO_DATA DeviceInfoData;
DWORD i;
VBString sDeviceDescription;
VBString sDeviceName;
BOOL rd;
DWORD dwRegDataType;
DWORD dwBufferSize;
BYTE *bDevInfo;
long retdata = 0;
DWORD Status;
DWORD Problem;
//初始化基本参数
sDeviceName = DeviceName;
sDeviceName.set_UCase();
//------------------------------------------------
//先通过枚举所有设备找出指定设备名称的相关GUID信息
//------------------------------------------------
//程序开始设下错误陷阱防止意外崩溃
hDevInfo = SetupDiGetClassDevs(NULL,NULL,NULL,DIGCF_PRESENT | DIGCF_ALLCLASSES);
if(hDevInfo == INVALID_HANDLE_VALUE){
return FALSE;
}
DeviceInfoData.cbSize = sizeof(SP_DEVINFO_DATA);
i = 0;
//开始循环枚举设备信息
while(SetupDiEnumDeviceInfo(hDevInfo, i, &DeviceInfoData)!=FALSE){
//------ 取得设备名称 ------
rd = SetupDiGetDeviceRegistryProperty(hDevInfo, 
  &DeviceInfoData, 
  SPDRP_DEVICEDESC, 
  &dwRegDataType, 
  NULL, 
  NULL, 
  &dwBufferSize);
if(rd!=TRUE){
bDevInfo = (BYTE *)GlobalAlloc(GMEM_ZEROINIT, dwBufferSize * 2);
rd = SetupDiGetDeviceRegistryProperty(hDevInfo, 
  &DeviceInfoData, 
  SPDRP_DEVICEDESC, 
  &dwRegDataType, 
  bDevInfo, 
  dwBufferSize, 
  NULL);
sDeviceDescription.set_Bytes(bDevInfo);
sDeviceDescription.set_UCase();
GlobalFree((HGLOBAL)bDevInfo);
if(sDeviceDescription == *sDeviceName){
if(CM_Get_DevNode_Status(&Status,&Problem,DeviceInfoData.DevInst,0)==CR_SUCCESS){
if((Status & DN_HAS_PROBLEM) && (CM_PROB_DISABLED == Problem)){
retdata=0;
}else{
retdata=1;
}
}
break;
}
}
i++;
}
SetupDiDestroyDeviceInfoList(hDevInfo);
return retdata;
}

Answer 7

SupermanKing 我加了
   Dim WMIObj As Object
   Set WMIObj = CreateObject("winmgmts://./root/cimv2")
才好用，你是不是贴漏了？完整Private Sub Command1_Click()
   Dim WMIObj As Object
   Set WMIObj = CreateObject("winmgmts://./root/cimv2")
   
   Dim POSTObj As Object
   Dim COMPost As Object
   
   Combo1.Clear
   Set POSTObj = WMIObj.InstancesOf("Win32_SerialPort")
   
   For Each COMPost In POSTObj
      '以下判断你的USB驱动名称进行识别
      Combo1.AddItem COMPost.Description & "(" & COMPost.DeviceID & ")"
      Combo1.ItemData(Combo1.ListCount - 1) = Int(Right(COMPost.DeviceID, Len(COMPost.DeviceID) - 3))
   Next
   
   Combo1.ListIndex = 0End Sub

Answer 8

呵呵，代码是从以前的程序截出来的，真的漏了   Dim WMIObj As Object
   Set WMIObj = CreateObject("winmgmts://./root/cimv2")
   '对象信息 ================================================
   Dim POSTObj As Object
   Dim COMPost As Object
   Combo1.Clear
   Set POSTObj = WMIObj.InstancesOf("Win32_SerialPort")
   For Each COMPost In POSTObj
      '以下判断你的USB驱动名称进行识别
      Combo1.AddItem COMPost.Description & "(" & COMPost.DeviceID & ")"
      Combo1.ItemData(Combo1.ListCount - 1) = Int(Right(COMPost.DeviceID, Len(COMPost.DeviceID) - 3))
   Next
   Combo1.ListIndex = 0