Serial port enumeration in Delphi using SetupDiGetClassDevs

Question

I'm trying to enumerate "friendly names" for COM ports. The ports may dynamically change as USB-serial devices are connected and disconnected at runtime.

Based on the possible methods described in this question, I am attempting to use the SetupDiGetClassDevs method.

I found this example code, but it is written for an older version of the setupapi unit (the original link to homepages.borland.com doesn't work of course).

I tried using the setupapi unit from the current JVCL(JVCL340CompleteJCL221-Build3845), but it doesn't seem to be compatible with Delphi 7. I get compiler errors:

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

In the call to function SetupDiGetDeviceRegistryProperty, I get the error "Types of actual and formal parameters must be identical" on the parameters @PropertyRegDataType, and @RequiredSize.

The Delphi3000 site says the code was written in 2004 and is intended for Delphi 7, so I'm not sure why it doesn't work with Delphi 7 now, unless setupapi has changed. Is anyone familiar with the changes to setupapi that could cause these problems?

I'm testing with a simple console program. The uses statement is " windows, sysutils, classes, setupAPI, Registry;"

The main program is:

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

Answer 1

The following procedure is working correctly for me (in Windows 8.1). It is important to use the parameter KEY_READ in the TRegistry.Constructor.

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 };

Answer 2

I was able to get some more specific suggestions by asking the question a different way with different tags.

It turns out there were errors in the delphi3000.com example code, and possibly errors in the JVCL code. After fixing the example code errors, I got it to work. I have not addressed the potential JVCL errors.

Here is the working code (as a simple console app) for enumerating the names of com ports:

{$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.