// Возвращает текст последней ошибки Windows и ее код в []
function LastOSErrorWithCode( dwErrorCode: DWORD ): String; overload;
begin
  Result := Format( '[%d] %s', [ dwErrorCode, SysErrorMessage( dwErrorCode ) ] );
end;

// Возвращает текст последней ошибки Windows и ее код в []
function LastOSErrorWithCode: String; overload;
begin
  Result := LastOSErrorWithCode( GetLastError );
end;

function GetPortName( h_DevInfo: HDEVINFO; const DevData: TSPDevInfoData; var SName: String ): Boolean;
var
  hDeviceKey: HKEY;
  szData: Array[ 0 .. 255 ] of Char;
  dwType, dwSize: DWORD;
begin
  hDeviceKey := SetupDiOpenDevRegKey( h_DevInfo, DevData, DICS_FLAG_GLOBAL, 0, DIREG_DEV, KEY_QUERY_VALUE );
  Result := hDeviceKey <> INVALID_HANDLE_VALUE;
  if not Result then
    Exit;

  try
    szData[ 0 ] := #0;
    dwSize := sizeof( szData );
    dwType := 0;
    Result := ( ERROR_SUCCESS = RegQueryValueEx( hDeviceKey, 'PortName', nil, @dwType, @szData, @dwSize ) ) and ( dwSize > 3 );
    if Result then
      SName := String( PChar( @szData ) );
  finally
    RegCloseKey( hDeviceKey );
  end;
end;

// Заполняет список компортов. В Objects заполняет номер порта (Integer)
// Если bNameWithComment=True - вместо имен COM1,COM2,... заполняет имена, как в диспетчере задач.
function EnumComPorts( List: TStrings; bNameWithComment: Boolean; var SError: String ): Boolean;
const
  LOCATION_INFO_LENGTH = 64;
var
  h_DevInfo: HDEVINFO;
  DeviceNumber: DWORD;
  DevData: TSPDevInfoData;
  RES: BOOL;

  SCurName: String;
  nPortNumber: DWORD;

  cLocationInfo: Array[ 0..LOCATION_INFO_LENGTH - 1 ] of Char;
  dwRegType: DWORD;
  predictedLength: DWORD;
begin
  h_DevInfo := SetupDiGetClassDevs( @GUID_DEVINTERFACE_SERENUM_BUS_ENUMERATOR, nil, 0, DIGCF_PRESENT );
  Result := THandle( h_DevInfo ) <> INVALID_HANDLE_VALUE;
  if not Result then begin
    SError := 'Не удалось прочитать список устройств: ' + LastOSErrorWithCode;
    Exit;
  end;

  try
    List.Clear;
    DeviceNumber := 0;
    repeat
      DevData.cbSize := SizeOf( TSPDevInfoData );
      RES := SetupDiEnumDeviceInfo( h_DevInfo, DeviceNumber, DevData );
      if RES then begin
        if GetPortName( h_DevInfo, DevData, SCurName ) then begin
          nPortNumber := StrToIntDef( Copy( SCurName, 4, MaxInt ), 0 );
          if bNameWithComment then begin
            FillChar( cLocationInfo, sizeof( cLocationInfo ), 0 );
            dwRegType := 0;
            predictedLength := 0;
            if SetupDiGetDeviceRegistryProperty(
              h_DevInfo,
              DevData,
              SPDRP_FRIENDLYNAME,
              dwRegType,
              @cLocationInfo,
              sizeof( cLocationInfo ),
              predictedLength
            ) then
              SCurName := String( PChar( @cLocationInfo ) );
          end;

          List.AddObject( SCurName, TObject( nPortNumber ) );
        end;

        Inc( DeviceNumber );
      end;
    until not RES;
  finally
    SetupDiDestroyDeviceInfoList(h_DevInfo);
  end;
end;

unit setupapi;

interface

uses Windows;

const
  ANYSIZE_ARRAY = 1;
  GUID_DEVINTERFACE_USB_DEVICE: TGUID              = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
  GUID_DEVINTERFACE_USBPRINT: TGUID                = '{28d78fad-5a12-11D1-ae5b-0000f803a8c2}';
  GUID_DEVINTERFACE_COMPORT: TGUID                 = '{86e0d1e0-8089-11d0-9ce4-08003e301f73}';
  GUID_DEVINTERFACE_SERENUM_BUS_ENUMERATOR: TGUID  = '{4D36E978-E325-11CE-BFC1-08002BE10318}';
  GUID_DEVINTERFACE_PRINTER: TGUID                 = '{4D36E979-E325-11CE-BFC1-08002BE10318}';
  GUID_DEVINTERFACE_PARCLASS: TGUID                = '{811FC6A5-F728-11D0-A537-0000F8753ED1}';
  GUID_DEVINTERFACE_PARALLEL: TGUID                = '{97F76EF0-F883-11D0-AF1F-0000F800845C}';
  GUID_DEVINTERFACE_MODEM: TGUID                   = '{2C7089AA-2E0E-11D1-B114-00C04FC2AAE4}';
  GUID_DEVINTERFACE_STORAGE_PORT: TGUID            = '{2accfe60-c130-11d2-b082-00a0c91efb8b}';

  DIGCF_PRESENT = $00000002;
  DIGCF_DEVICEINTERFACE = $00000010;
  DIGCF_ALLCLASSES = $00000004;
  DIGCF_PROFILE    = $00000008;

  SPDRP_DEVICEDESC                  = $00000000;
  SPDRP_HARDWAREID                  = $00000001;
  SPDRP_SERVICE                     = $00000004;
  SPDRP_CLASS                       = $00000007;
  SPDRP_CLASSGUID                   = $00000008;
  SPDRP_FRIENDLYNAME                = $0000000C;
  SPDRP_LOCATION_INFORMATION        = $0000000D;
  SPDRP_PHYSICAL_DEVICE_OBJECT_NAME = $0000000E;
  SPDRP_UI_NUMBER                   = $00000010;
  SPDRP_BUSNUMBER                   = $00000015;
  SPDRP_ENUMERATOR_NAME             = $00000016;

  CR_SUCCESS = 0;

  //cfgmgr32.h
  CM_DRP_DEVICEDESC                  = $00000001;
  CM_DRP_HARDWAREID                  = $00000002;
  CM_DRP_PHYSICAL_DEVICE_OBJECT_NAME = $0000000F;
  CM_DRP_UI_NUMBER                   = $00000011;
  CM_DRP_BUSNUMBER                   = $00000016;
  CM_DRP_ENUMERATOR_NAME             = $00000017;
  CM_DRP_UI_NUMBER_DESC_FORMAT       = $0000001E;

  DICS_ENABLE = $00000001;
  DICS_DISABLE = $00000002;

  DICS_FLAG_GLOBAL = $00000001;
  DICS_FLAG_CONFIGSPECIFIC = $00000002;  // make change in specified profile only
  DIREG_DEV = $00000001;

  DIF_PROPERTYCHANGE = $00000012;

type
  ULONG_PTR = DWORD;
  PTSTR = PAnsiChar;
  HDEVINFO = Pointer;

  PSPDevInfoData = ^TSPDevInfoData;
  SP_DEVINFO_DATA = packed record
    cbSize: DWORD;
    ClassGuid: TGUID;
    DevInst: DWORD; // DEVINST handle
    Reserved: ULONG_PTR;
  end;
  TSPDevInfoData = SP_DEVINFO_DATA;

  PSPDeviceInterfaceData = ^TSPDeviceInterfaceData;
  SP_DEVICE_INTERFACE_DATA = packed record
    cbSize: DWORD;
    InterfaceClassGuid: TGUID;
    Flags: DWORD;
    Reserved: ULONG_PTR;
  end;
  TSPDeviceInterfaceData = SP_DEVICE_INTERFACE_DATA;
  TSPInterfaceDeviceData = TSPDeviceInterfaceData;

  PSPDeviceInterfaceDetailDataA = ^TSPDeviceInterfaceDetailDataA;
  SP_DEVICE_INTERFACE_DETAIL_DATA_A = packed record
    cbSize: DWORD;
    DevicePath: array [0..ANYSIZE_ARRAY - 1] of AnsiChar;
  end;
  TSPDeviceInterfaceDetailDataA = SP_DEVICE_INTERFACE_DETAIL_DATA_A;
  TSPDeviceInterfaceDetailData = TSPDeviceInterfaceDetailDataA;
  TSPInterfaceDeviceDetailData = TSPDeviceInterfaceDetailData;
  PSPDeviceInterfaceDetailData = PSPDeviceInterfaceDetailDataA;
  PSPInterfaceDeviceDetailData = PSPDeviceInterfaceDetailData;

  DI_FUNCTION = UINT;
  TSPClassInstallHeader = record
    cbSize: DWORD;
    InstallFunction: DI_FUNCTION;
  end;
  PSPClassInstallHeader = ^TSPClassInstallHeader;

  TSPPropChangeParams = record
    ClassInstallHeader: TSPClassInstallHeader;
    StateChange: DWORD;
    Scope: DWORD;
    HwProfile: DWORD;
  end;

function SetupDiGetClassDevs( ClassGuid: PGUID; const Enumerator: PTSTR; hwndParent: HWND; Flags: DWORD ): HDEVINFO; stdcall; external 'setupapi.dll' name 'SetupDiGetClassDevsA';
function SetupDiEnumDeviceInfo( DeviceInfoSet: HDEVINFO; MemberIndex: DWORD; var DeviceInfoData: TSPDevInfoData ): BOOL; stdcall; external 'setupapi.dll';
function SetupDiEnumDeviceInterfaces( DeviceInfoSet: HDEVINFO; DeviceInfoData: PSPDevInfoData; const InterfaceClassGuid: TGUID; MemberIndex: DWORD; var DeviceInterfaceData: TSPDeviceInterfaceData ): BOOL; stdcall; external 'setupapi.dll';
function SetupDiGetDeviceInterfaceDetail( DeviceInfoSet: HDEVINFO; DeviceInterfaceData: PSPDeviceInterfaceData; DeviceInterfaceDetailData: PSPDeviceInterfaceDetailData; DeviceInterfaceDetailDataSize: DWORD; RequiredSize: PDWORD; Device: PSPDevInfoData ): BOOL; stdcall; external 'setupapi.dll' name 'SetupDiGetDeviceInterfaceDetailA';
function SetupDiDestroyDeviceInfoList( DeviceInfoSet: HDEVINFO ): BOOL; stdcall; external 'setupapi.dll';
function SetupDiGetDeviceRegistryProperty( DeviceInfoSet: HDEVINFO; const DeviceInfoData: TSPDevInfoData; Property_: DWORD; var PropertyRegDataType: DWORD; PropertyBuffer: PBYTE; PropertyBufferSize: DWORD; var RequiredSize: DWORD ): BOOL; stdcall; external 'setupapi.dll' name 'SetupDiGetDeviceRegistryPropertyA';
function SetupDiOpenDevRegKey( DeviceInfoSet: HDEVINFO; const DeviceInfoData: TSPDevInfoData; Scope, HwProfile, KeyType: DWORD; samDesired: REGSAM ): HKEY; stdcall; external 'setupapi.dll';

function SetupDiCallClassInstaller( InstallFunction: DI_FUNCTION; DeviceInfoSet: HDEVINFO; pDeviceInfoData: PSPDevInfoData ): BOOL; stdcall; external 'setupapi.dll';
function SetupDiSetClassInstallParams( DeviceInfoSet: HDEVINFO; pDeviceInfoData: PSPDevInfoData; pClassInstallParams: PSPClassInstallHeader; ClassInstallParamsSize: DWORD ): BOOL; stdcall; external 'setupapi.dll' name 'SetupDiSetClassInstallParamsA';
function SetupDiClassGuidsFromName( ClassName: PChar; ClassGuidList: PGUID; ClassGuidListSize: DWORD; var RequiredSize: DWORD ): BOOL; stdcall; external 'setupapi.dll' name 'SetupDiClassGuidsFromNameA';

function CM_Get_Child( out pdnDevInst: DWORD; dnDevInst: DWORD; ulFlags: ULONG ): DWORD; stdcall; external 'CfgMgr32.dll';
function CM_Get_Sibling( out pdnDevInst: DWORD; dnDevInst: DWORD; ulFlags: ULONG ): DWORD; stdcall; external 'CfgMgr32.dll';
function CM_Get_DevNode_Registry_PropertyW( dnDevInst: DWORD; ulProperty: ULONG; pulRegDataType: PULONG; Buffer: Pointer; pulLength: PULONG; ulFlags: ULONG ): DWORD; stdcall; external 'CfgMgr32.dll';

implementation

end.

procedure TForm1.Button1Click(Sender: TObject);
var
  SError: String;
begin
  if not EnumComPorts( Memo1.Lines, True, SError ) then
    ShowMessage( SError );
end;

procedure EnumComPorts(Ports: TStrings);
var
   KeyHandle: HKEY;
   ErrCode, Index: Integer;
   ValueName, Data: string;
   ValueLen, DataLen, ValueType: DWORD;
   TmpPorts: TStringList;
begin
     ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\SERIALCOMM',
                             0, KEY_READ, KeyHandle);

     if ErrCode <> ERROR_SUCCESS
      then raise EComPort.Create(CError_RegError, ErrCode);

     TmpPorts := TStringList.Create;
     try
        Index := 0;
        repeat
              ValueLen := 256;
              DataLen := 256;
              SetLength(ValueName, ValueLen);
              SetLength(Data, DataLen);

              ErrCode := RegEnumValue(KeyHandle, Index, PChar(ValueName),
                                      Cardinal(ValueLen), nil, @ValueType,
                                      PByte(PChar(Data)), @DataLen);

              if ErrCode = ERROR_SUCCESS then
               begin
                    SetLength(Data, DataLen);
                    TmpPorts.Add(Data);
                    Inc(Index);
               end else
              if ErrCode <> ERROR_NO_MORE_ITEMS
               then raise EComPort.Create(CError_RegError, ErrCode);
        until (ErrCode <> ERROR_SUCCESS) ;

        TmpPorts.Sort;
        Ports.Assign(TmpPorts);
     finally
       RegCloseKey(KeyHandle);
       TmpPorts.Free;
     end;
end;