【问题标题】:Serial port enumeration in Delphi using SetupDiGetClassDevsDelphi 中使用 SetupDiGetClassDevs 进行串口枚举
【发布时间】:2011-02-15 04:44:56
【问题描述】:

我正在尝试枚举 COM 端口的“友好名称”。端口可能会随着 USB 串行设备在运行时的连接和断开而动态变化。

基于this question 中描述的可能方法,我正在尝试使用SetupDiGetClassDevs 方法。

我找到了this example code,但它是为旧版本的 setupapi 单元编写的(当然,指向 homepages.borland.com 的原始链接不起作用)。

我尝试使用当前 JVCL(JVCL340CompleteJCL221-Build3845) 中的 setupapi 单元,但它似乎与 Delphi 7 不兼容。我收到编译器错误:

if SetupDiGetDeviceRegistryProperty(DevInfoHandle,DeviceInfoData,
    RegProperty,
    @PropertyRegDataType,
    @S1[1],RequiredSize,@RequiredSize) then begin

在调用函数SetupDiGetDeviceRegistryProperty时, 我在参数 @PropertyRegDataType@RequiredSize 上收到错误“实际参数和形式参数的类型必须相同”。

Delphi3000 网站说代码是在 2004 年编写的,并且是为 Delphi 7 设计的,所以我不确定为什么它现在不能与 Delphi 7 一起使用,除非 setupapi 发生了变化。是否有人熟悉可能导致这些问题的 setupapi 更改?

我正在使用一个简单的控制台程序进行测试。使用语句是“windows, 系统工具, 类, 设置API, 注册表;"

主程序是:

  begin
  ComPortStringList := SetupEnumAvailableComPorts;
  for Index := 0 to ComPortStringList.Count - 1 do
      writeln(ComPortStringList[Index]);
  end;
  end.

【问题讨论】:

  • 此问题中示例代码的链接现已过时(2020 年 9 月)。请参阅Grzegorz Skoczylas 的答案,它适用于 Windows 10 上的 Delphi 7(并且适用于内置和 USB 转串行适配器 COM 端口)。

标签: delphi serial-port enumerate


【解决方案1】:

以下过程对我来说是正确的(在 Windows 8.1 中)。在TRegistry.Constructor中使用参数KEY_READ很重要。

procedure  EnumComPorts(const   Ports:  TStringList);

var
  nInd:  Integer;

begin  { EnumComPorts }
  with  TRegistry.Create(KEY_READ)  do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if  OpenKey('hardware\devicemap\serialcomm', False)  then
        try
          Ports.BeginUpdate();
          try
            GetValueNames(Ports);
            for  nInd := Ports.Count - 1  downto  0  do
              Ports.Strings[nInd] := ReadString(Ports.Strings[nInd]);
            Ports.Sort()
          finally
            Ports.EndUpdate()
          end { try-finally }
        finally
          CloseKey()
        end { try-finally }
      else
        Ports.Clear()
    finally
      Free()
    end { try-finally }
end { EnumComPorts };

【讨论】:

  • 此过程在 Windows 10 中也应该可以正常工作,但我还没有检查过。
  • 也适用于 Windows 7
  • 虽然我尚未对此进行测试,但我正在手动查看 Windows 10 Regedit,但在 devicemap 下看不到 serialcom 键。
  • 这个程序对我有用多年。它适用于 Windows 7、8 和 10。目前我有 Windows 10 Pro。你确定你在 HKEY_LOCAL_MACHINE 分支里检查过吗?
  • 可以通过 @GrzegorzSkoczylas 确认这适用于 Windows 10。请注意,密钥是 SERIALCOMM,而不是 SERIALCOM(即两个“m”)。
【解决方案2】:

我得到了asking the question a different way with different tags的一些更具体的建议。

事实证明,delphi3000.com 示例代码中存在错误,并且 JVCL 代码中可能存在错误。修复示例代码错误后,我让它工作。我还没有解决潜在的 JVCL 错误。

这里是枚举 com 端口名称的工作代码(作为一个简单的控制台应用程序):

{$APPTYPE CONSOLE}
program EnumComPortsTest;


uses
  windows,
  sysutils,
  classes,
  setupAPI,
  Registry;

{$R *.RES}

var
   ComPortStringList : TStringList;

(*

The function below returns a list of available COM-ports
(not open by this or an other process), with friendly names. The list is formatted as follows:

COM1: = Communications Port (COM1)
COM5: = NI Serial Port (Com5)
COM6: = NI Serial Port (Com6)
COM7: = USB Serial Port (COM7)
COM8: = Bluetooth Communications Port (COM8)
COM9: = Bluetooth Communications Port (COM9)

This code originally posted at http://www.delphi3000.com/articles/article_4001.asp?SK=
errors have been fixed so it will work with Delphi 7 and SetupAPI from JVCL
*)

function SetupEnumAvailableComPorts:TstringList;
// Enumerates all serial communications ports that are available and ready to
// be used.

// For the setupapi unit see
// http://homepages.borland.com/jedi/cms/modules/apilib/visit.php?cid=4&lid=3

var
  RequiredSize:             Cardinal;
  GUIDSize:                 DWORD;
  Guid:                     TGUID;
  DevInfoHandle:            HDEVINFO;
  DeviceInfoData:           TSPDevInfoData;
  MemberIndex:              Cardinal;
  PropertyRegDataType:      DWord;
  RegProperty:              Cardinal;
  RegTyp:                   Cardinal;
  Key:                      Hkey;
  Info:                     TRegKeyInfo;
  S1,S2:                    string;
  hc:                       THandle;
begin
  Result:=Nil;
//If we cannot access the setupapi.dll then we return a nil pointer.
  if not LoadsetupAPI then exit;
  try
// get 'Ports' class guid from name

    GUIDSize := 1;    // missing from original code - need to tell function that the Guid structure contains a single GUID
    if SetupDiClassGuidsFromName('Ports',@Guid,GUIDSize,RequiredSize) then begin
//get object handle of 'Ports' class to interate all devices
       DevInfoHandle:=SetupDiGetClassDevs(@Guid,Nil,0,DIGCF_PRESENT);
       if Cardinal(DevInfoHandle)<>Invalid_Handle_Value then begin
         try
           MemberIndex:=0;
           result:=TStringList.Create;
//iterate device list
           repeat
             FillChar(DeviceInfoData,SizeOf(DeviceInfoData),0);
             DeviceInfoData.cbSize:=SizeOf(DeviceInfoData);
//get device info that corresponds to the next memberindex
             if Not SetupDiEnumDeviceInfo(DevInfoHandle,MemberIndex,DeviceInfoData) then
               break;
//query friendly device name LIKE 'BlueTooth Communication Port (COM8)' etc
             RegProperty:=SPDRP_FriendlyName;{SPDRP_Driver, SPDRP_SERVICE, SPDRP_ENUMERATOR_NAME,SPDRP_PHYSICAL_DEVICE_OBJECT_NAME,SPDRP_FRIENDLYNAME,}

             SetupDiGetDeviceRegistryProperty(DevInfoHandle,
                                                   DeviceInfoData,
                                                   RegProperty,
                                                   PropertyRegDataType,
                                                   NIL,0,RequiredSize);
             SetLength(S1,RequiredSize);

             if SetupDiGetDeviceRegistryProperty(DevInfoHandle,DeviceInfoData,
                                                 RegProperty,
                                                 PropertyRegDataType,
                                                 @S1[1],RequiredSize,RequiredSize) then begin
               KEY:=SetupDiOpenDevRegKey(DevInfoHandle,DeviceInfoData,DICS_FLAG_GLOBAL,0,DIREG_DEV,KEY_READ);
               if key<>INValid_Handle_Value then begin
                 FillChar(Info, SizeOf(Info), 0);
//query the real port name from the registry value 'PortName'
                 if RegQueryInfoKey(Key, nil, nil, nil, @Info.NumSubKeys,@Info.MaxSubKeyLen, nil, @Info.NumValues, @Info.MaxValueLen,
                                                        @Info.MaxDataLen, nil, @Info.FileTime) = ERROR_SUCCESS then begin
                   RequiredSize:= Info.MaxValueLen + 1;
                   SetLength(S2,RequiredSize);
                   if RegQueryValueEx(KEY,'PortName',Nil,@Regtyp,@s2[1],@RequiredSize)=Error_Success then begin
                     If (Pos('COM',S2)=1) then begin
//Test if the device can be used
                       hc:=CreateFile(pchar('\\.\'+S2+#0),
                                      GENERIC_READ or GENERIC_WRITE,
                                      0,
                                      nil,
                                      OPEN_EXISTING,
                                      FILE_ATTRIBUTE_NORMAL,
                                      0);
                       if hc<> INVALID_HANDLE_VALUE then begin
                         Result.Add(Strpas(PChar(S2))+': = '+StrPas(PChar(S1)));
                         CloseHandle(hc);
                       end;
                     end;
                   end;
                 end;
                 RegCloseKey(key);
               end;
             end;
             Inc(MemberIndex);
           until False;
//If we did not found any free com. port we return a NIL pointer.
           if Result.Count=0 then begin
             Result.Free;
             Result:=NIL;

           end
         finally
           SetupDiDestroyDeviceInfoList(DevInfoHandle);
         end;
       end;
    end;
  finally
    UnloadSetupApi;
  end;
end;



var
   index : integer;

begin

  ComPortStringList := SetupEnumAvailableComPorts;

  if (ComPortStringList <> nil) and (ComPortStringList.Count > 0) then
    for Index := 0 to ComPortStringList.Count - 1 do
      writeln(ComPortStringList[Index]);

end.

【讨论】:

  • 在此代码中,SetupDiEnumDeviceInfo() 总是返回 false。
【解决方案3】:

看起来PDWord 类型的一些参数在SetupApi.pas 中被var DWord 替换。您只需要像这样从代码中的这些参数中删除“@”:

if SetupDiGetDeviceRegistryProperty(DevInfoHandle,DeviceInfoData,
                                    RegProperty,
                                    PropertyRegDataType,
                                    @S1[1],RequiredSize,RequiredSize) then begin

【讨论】:

    【解决方案4】:

    您是否打开了“键入@运算符”?项目选项,“语法选项”下的编译器选项卡。如果启用该选项,许多第三方代码会中断。

    【讨论】:

    • 此项目未选中“Typed @ operator”选项。我已经在调用周围添加了 {$VARSTRINGCHECKS OFF},它修复了 @S1[1] 上的错误。你能想出其他可能的问题吗?
    【解决方案5】:

    为了更容易操作,您可以考虑简单地使用列出这些名称的注册表,例如:

      ErrCode := RegOpenKeyEx(
        HKEY_LOCAL_MACHINE,
        'HARDWARE\DEVICEMAP\SERIALCOMM',
        0,
        KEY_READ,
        KeyHandle);
    

    (我省略了挥手的东西)。

    您也可以考虑使用 WMI - 请参阅 Magenta Systems 的 this example - 您现在可以获得几乎所有与硬件相关的内容。

    【讨论】:

      【解决方案6】:

      我为串行端口类改编了来自 RRUZ answer 的以下代码。 Win10 20H2下运行良好。

      {$APPTYPE CONSOLE}
      
      uses
        SysUtils,
        ActiveX,
        ComObj,
        Variants;
      
      
      procedure  GetWin32_SerialPortInfo;
      const
        WbemUser            ='';
        WbemPassword        ='';
        WbemComputer        ='localhost';
        wbemFlagForwardOnly = $00000020;
      var
        FSWbemLocator : OLEVariant;
        FWMIService   : OLEVariant;
        FWbemObjectSet: OLEVariant;
        FWbemObject   : OLEVariant;
        oEnum         : IEnumvariant;
        iValue        : LongWord;
      begin;
        FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
        FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
        FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_SerialPort','WQL',wbemFlagForwardOnly);
        oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
        while oEnum.Next(1, FWbemObject, iValue) = 0 do
        begin
          // for other fields: https://docs.microsoft.com/en-us/windows/win32/cimwin32prov/win32-serialport
          Writeln(Format('DeviceID        %s',[String(FWbemObject.DeviceID)]));// String
          Writeln(Format('Name            %s',[String(FWbemObject.Name)]));// String
          Writeln(Format('Description     %s',[String(FWbemObject.Description)]));// String
          FWbemObject:=Unassigned;
        end;
      end;
      
      
      begin
       try
          CoInitialize(nil);
          try
            GetWin32_SerialPortInfo;
          finally
            CoUninitialize;
          end;
       except
          on E:EOleException do
              Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
          on E:Exception do
              Writeln(E.Classname, ':', E.Message);
       end;
       Writeln('Press Enter to exit');
       Readln;
      end.
      

      输出:

      DeviceID        COM7
      Name            Silicon Labs CP210x USB to UART Bridge (COM7)
      Description     Silicon Labs CP210x USB to UART Bridge
      Press Enter to exit
      

      【讨论】:

        猜你喜欢
        • 1970-01-01
        • 2013-03-08
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 2021-04-09
        • 1970-01-01
        • 1970-01-01
        • 2012-04-04
        相关资源
        最近更新 更多