function GetSerialPortNames: string;
var
 reg: TRegistry;
 l, v: TStringList;
 n: integer;
begin
 l := TStringList.Create;
 v := TStringList.Create;
 reg := TRegistry.Create;
 try
   reg.RootKey := HKEY_LOCAL_MACHINE;
   reg.OpenKey('HARDWARE\DEVICEMAP\SERIALCOMM', false);
   reg.GetValueNames(l);
   for n := 0 to l.Count - 1 do
     v.Add(reg.ReadString(l[n]));
   Result := v.CommaText;
 finally
   reg.Free;
   l.Free;
   v.Free;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const BufSize = $FFFF;
var
 Buf_DevList: Array[0..BufSize] of Char;
 DevName: PChar;
begin
Win32check(QueryDosDevice(nil, Buf_DevList, BufSize) <> 0);
DevName := @Buf_DevList;
 while DevName^ <> #00 do
 begin
   if (StrLIComp('COM', DevName, 3) = 0) then
     ListBox1.Items.Add(DevName);
   DevName := StrEnd(DevName)+1;
 end;
end;

uses Windows, Classes, SysUtils, SetupAPI;

const
 PortsGUID: TGUID = '{4D36E978-E325-11CE-BFC1-08002BE10318}'; // ports

function EnumerateUsbCom(VID, PID: Integer; Ports: TStrings): Integer;
var
 GUID: TGUID;
 PnPHandle: HDevInfo; // handle на базу данных драйверов, раздел ports
 i, j: DWORD;
 DeviceInfoData: SP_DEVINFO_DATA;
 Err: Integer;
 RequiredLength: DWORD;
 DevicePath: string;
 RegType: DWORD;
 Name: string;
 s: string;
 DevPID: Word;
 DevVID: Word;
 RegKey: HKey;
begin
 Ports.Clear;
 Result := 0;
 GUID := PortsGUID;

 // получаем handle на базу данных портов присутствующих в системе
 // win7 compat: с флагом DIGCF_DEVICEINTERFACE в некоторых компах с семеркой
 // перечисляются только нативные ком-порты
 PnPHandle := SetupDiGetClassDevs(@GUID, nil, 0, DIGCF_PRESENT { or
     DIGCF_DEVICEINTERFACE } );

 if PnPHandle = Pointer(INVALID_HANDLE_VALUE) then // не можем открыть базу
   raise Exception.Create(SysErrorMessage(GetLastError));
 try
   i := 0; // первый порт
   DeviceInfoData.cbSize := SizeOf(DeviceInfoData);
   while SetupDiEnumDeviceInfo(PnPHandle, i, DeviceInfoData) do
   // получаем последовательно порты, пока они есть.
   begin
     DevicePath := '';
     Name := '';
     // получаем размер строчки HardwareID
     SetupDiGetDeviceRegistryProperty(PnPHandle, DeviceInfoData,
       SPDRP_HARDWAREID, RegType, nil, 0, RequiredLength);
     Err := GetLastError;
     if Err = ERROR_INSUFFICIENT_BUFFER then
     // только эта ошибка должна возникнуть - все другое - что-то не так
     begin
       if Length(Name) < RequiredLength div SizeOf(Char) then
       // если буфер маленький, то
         SetLength(Name, RequiredLength div SizeOf(Char));
       // устанавливаем размер буфера

       if not SetupDiGetDeviceRegistryProperty(PnPHandle, DeviceInfoData,
         SPDRP_HARDWAREID, RegType, @Name[1], RequiredLength, RequiredLength)
       then // получаем HardwareID
       begin
         inc(i); // если ошибка, то смотрим следущий порт
         Continue;
       end;
     end
     else
       raise Exception.Create(SysErrorMessage(Err));

     Name := UpperCase(Name);
     // чтобы сравнивать строки, переводим все в заглавные буквы
     if Copy(Name, 1, 3) = 'USB' then
     // если первые три символа HardwareID = 'USB' - то это у нас виртуальный порт
     begin
       j := pos('VID_', Name) + 4; // ищем где у нас VID
       s := '';
       while Name[j] <> '&' do // получаем VID
       begin
         s := s + Name[j];
         inc(j);
       end;
       DevVID := StrToInt('$' + s);
       // OutputDebugString(PChar('vid = ' + IntToHex(DevVID, 4)));
       j := pos('PID_', Name) + 4; // ищем PID
       s := '';
       while (Name[j] <> '&') and (Name[j] <> #0) do // получаем PID
       begin
         s := s + Name[j];
         inc(j);
       end;
       DevPID := StrToInt('$' + s);
       // OutputDebugString(PChar('pid = ' + IntToHex(DevPID, 4)));
       if (DevVID = VID) and (DevPID = PID) then // если VID и PID - наши, то
       begin
         SetLength(DevicePath, 10);
         // 10 символов на название ком-порта - хватит (максимальный COM999999 [последний символ = #0])
         RegKey := SetupDiOpenDevRegKey(PnPHandle, DeviceInfoData,
           DICS_FLAG_GLOBAL, 0, DIREG_DEV, KEY_QUERY_VALUE);
         // получаем Handle на раздел реестра экземпляра устройства
         if RegKey = INVALID_HANDLE_VALUE then
         begin
           inc(i); // если ошибка - следущий порт
           Continue;
         end;
         try
           RequiredLength := 10 * SizeOf(Char);
           if RegQueryValueEx(RegKey, 'PortName', nil, @RegType,
             @DevicePath[1], @RequiredLength) <> ERROR_SUCCESS then
           // в PortName записано название порта (например - СОМ5)
           begin
             inc(i);
             Continue;
           end;
           DevicePath := Copy(DevicePath, 1, RequiredLength div SizeOf(Char) -
             1); // в RequiredLength - размер полученной строки, минус 1 - последний ноль нам не нужен
           Ports.Add(DevicePath); // добавлеяем имя порта
           inc(Result);
           // результат функции - количество портов для данного VID&PID
         finally
           RegCloseKey(RegKey); // Handle надо закрыть, даже в случае ошибки
         end;
       end;
     end;
     inc(i); // следущий порт
   end;
 finally
   SetupDiDestroyDeviceInfoList(PnPHandle); // освобождаем занятую память.
 end;
end;