.....
.....
 if RegOpenKey(HKEY_LOCAL_MACHINE,PChar('HARDWARE\DEVICEMAP\SERIALCOMM'),HK)=0 then
 begin // попробуем определить сколько фактических портов в этом ключе
   if (RegQueryInfoKey( HK,0,0,0,@I,0,0,@dwTp,@K,0,0,0 ) = 0 ) and (dwTp > 0) then
     begin  // да, определённо там есть какие то параметры...
     Dec( dwTp );   // коррекция для дальнейшего удобства
     Inc( K ); // коррекция для дальнейшего удобства
     for I := 0 to dwTp do
        begin
        dwSz := K;
        SetLength( Val, dwSz );
        RegEnumValue( HK, I, @Val[1], dwSz, 0,0,0,0 );
       Val := RegKeyGetStr( HK, Val );  // имя COM порта
        if StrIsStartingFrom( PChar(Val), PChar('COM')) then
           begin
           // поскольку найден ещё один COM порт, учтём его в общем количестве
           Inc( NumPorts );
           TmpArrPorts[NumPorts] := Str2Int(Copy( Val, 4, 3 ));
           end;
        end;
     RegCloseKey( HK ); // всё просмотрено, закрываем этот ключ реестра
............
............
............
if RegOpenKey(HKEY_LOCAL_MACHINE,('SYSTEM\CurrentControlSet\Services\serenum\Enum') ,HK) = 0 then
 begin
 // читаем сколько COM портов зарегистрировано в этой ветке реестра
 dwSz := 4;
 RegQueryValueEx( HK, PChar('Count'), 0, @dwTp, @I, @dwSz );
 if I > 0 then
    begin
    Dec( I );
     // циклично переберём все символьные номера портов
     // и вычитаем параметры нового пути для дальнейшего поиска...
    for N := 0 to I do
       begin
       Val := RegKeyGetStr( HK, Int2Str(N) );
       if Val > '' then TmpArrFIFO[N] := 'SYSTEM\CurrentControlSet\Enum\' + Val + '\Device Parameters';
       end;
    RegCloseKey( HK ); // вычитали всё, что смогли найти, закроем этот ключ реестра

// теперь производим ещё раз сверку строковых имён портов, которые уже имеем,
// и те, что в новой ветке реестра обнаруживаются.
..........
...........
.............

var  buffer:string;
DCB:TDCB;
...
for i:=255 downto 1  do
begin
   port_name:= 'com'+ inttostr(i);
   hCom:=CreateFile(PChar(port_name), GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
if hCom<>INVALID_HANDLE_VALUE then
  begin
    SetupComm(hCom,1600,1600);
    GetCommState(hCom,DCB);
     //настроить нужным образом

       with DCB do begin                                BaudRate:=38400;
                   ByteSize:=8;
                   Parity:=1;
                   StopBits:=ONESTOPBIT;
                   end;

           if not SetCommState(hCom, DCB)
                     then  begin
                           showMessage ('Error setting port parameters');
                           CloseHandle(hCom);
                           end
                      else
                       if not PurgeComm(hCom, PURGE_TXCLEAR or PURGE_RXCLEAR)
                        then   begin
                                showMessage ('Error purging port');
                                CloseHandle(hCom);
                               end
                        else
                        begin
                          clearCommError(hCom,Errors,@TheStruct);
                             if TheStruct.cbInQue>0 then
                                                     begin                 //что-то пришло
                                  SetLength(buffer,TheStruct.cbInQue);
                                  readport;
  ....
                                                         end
                                                           else begin
                                                              CloseHandle(hCom);
                                                              showMessage ('no data');
                                                             end;
                            end;
   end ;   //if hcom
end;   //for

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;