01.07.2014 23:34:11

Правильное получение списка COM-портов в Delphi

    Правильное получение списка COM-портов в Delphi

    Задачи работы с железом – частая штука для Delphi разработчиков. Но если почти все знают, как работать с COM-портом – открывать его, отправлять и принимать данные, то практически нигде не описан наиболее корректный вариант получения списка портов. Давайте, для начала рассмотрим несколько наиболее часто встречаемые в интернете варианты и попробуем разобраться в них.

    Прежде всего определимся, что среди COM-портов в Windows есть 2 типа устройств – непосредственно COM-порты и модемы:

    Их следует разделять, например, когда надо автоматически подключится к какому-то определённому устройству или не выводить модемы. Поэтому было бы неплохо получить не просто список, но и типы устройств и их имена.

    Вариант 1. Опрос всех портов по очереди

    Решение «в лоб», что называется. Давайте будем открывать по очереди список COM-порты, а какие откроются – выведем в списке. Выглядит как-то так:

    1. procedure TForm1.EnumPorts1();
    2. var i: integer;
    3.     h: THandle;
    4. begin
    5.   for i:=1 to 32 do
    6.     begin
    7.     h:=CreateFile(PChar('COM'+IntToStr(i)),
    8.       GENERIC_READ or GENERIC_WRITE,
    9.       0,
    10.       nil,
    11.       OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
    12.     If(h<>INVALID_HANDLE_VALUE)then
    13.       ComPort.Items.Add('COM'+IntToStr(i));
    14.     CloseHandle(h);
    15.     end;
    16. end;

    Честно говоря, вариант хреноватенький. Из плюсов – разве что очевидная реализация и возможность получить список COM-портов без прав администратора. Минусов тут огромнейшее множество:

    • У пользователя может быть, к примеру, виртуальный порт COM158, следовательно циклом в 32 порта не ограничишься, а опрос большого количества портов занимает немало времени.
    • Всякие «левые» устройства – виртуальные Bluetooth порты (которые встречаются в каждом втором ноутбуке) и прочее железо может неадекватно реагировать на открытие порта – вплоть до зависания системы.
    • Нельзя определить имя устройства в системе и тип устройства (порт или модем)

    Как показывает практика (да и здравый смысл тоже), процент зависаний и отказов для такого варианта довольно велик. Так что для коммерческой программы такой вариант вовсе не подойдёт, хотя процент коммерческих программ, опрашивающих таким способом железо, довольно велико.

    Вариант 2. Чтение списка из реестра

    Оказывается, в ветке HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM хранится список активных портов системы. Можно их просто прочитать и всё будет ок.

    1. procedure TForm1.EnumPorts2();
    2. var reg  : TRegistry;
    3.     l    : TStringList;
    4.     i    : integer;
    5. begin
    6.   l := TStringList.Create;
    7.   reg:=TRegistry.Create;
    8.   try
    9.     reg.RootKey := HKEY_LOCAL_MACHINE;
    10.     reg.OpenKey('HARDWARE\DEVICEMAP\SERIALCOMM', false);
    11.     reg.GetValueNames(l);
    12.     for i:=0 to l.Count-1 do
    13.       ComPort.Items.Add(reg.ReadString(l[i]));
    14.   finally
    15.     reg.Free;
    16.     l.Free;
    17.   end;
    18. end;

    Кстати, данный вариант пользуется большой популярностью. Причина тому одна – он быстрый и работал (во времена Windows XP) практически безотказно. Однако и у него есть минусы:

    • Во времена Windows XP всё работало безотказно, но поскольку ветка HKEY_LOCAL_MACHINE в Windows Vista, Windows 7 и Windows 8 закрыта для не-админа (не для пользователей группы «Администраторы», а для пользователя аналога root в Linux), то программу приходится запускать от имени администратора. Можно, конечно, добавить manifest, что решит 99% проблем, но останется тот 1% (например, home-версия Windows) и неприятный осадок.
    • Нельзя определить имя устройства в системе и тип устройства (порт или модем)

    Данный вариант вполне приемлемый для коммерческого решения, однако есть приёмчики получше.

    Вариант 3. Правильный. Используем Windows Driver Kit

    Наиболее сложный, но и наиболее правильный вариант.

    1. const
    2.   GUID_DEVICEINTERFACE_COMPORT:TGUID=(
    3.     D1 : $86E0D1E0;
    4.     D2 : $8089;
    5.     D3 : $11D0;
    6.     D4 : ($9C,$E4,$08,$00,$3E,$30,$1F,$73);
    7.    );
    8.   GUID_DEVICEINTERFACE_MODEM:TGUID=(
    9.     D1 : $2C7089AA;
    10.     D2 : $2E0E;
    11.     D3 : $11D1;
    12.     D4 : ($B1,$14,$00,$C0,$4F,$C2,$AA,$E4);
    13.    );
    14. function TForm1.EnumPorts3(
    15.    const guid:TGUID;
    16.    PortClass :TPortClass):boolean;
    17. var h             : THandle;
    18.     devinfo       : SP_DEVICE_INTERFACE_DATA;
    19.     bMoreItems    : boolean;
    20.     nIndex        : longint;
    21.     hDeviceKey    : HKEY;
    22.     szData        : array[0..255]of Char;
    23.     dwType,dwSize : DWORD;
    24.     item          : TComPortInfo;
    25. begin
    26.   h:=SetupDiGetClassDevs(
    27.       @guid,
    28.       nil,
    29.       0,
    30.       DIGCF_PRESENT or DIGCF_INTERFACEDEVICE
    31.       );
    32.   if(h=INVALID_HANDLE_VALUE)then
    33.       begin
    34.       exit(false);
    35.       end;
    36.   try
    37.     nIndex:=0;
    38.     bMoreItems:=true;
    39.     while(bMoreItems)do
    40.       begin
    41.       devinfo.cbSize:=sizeof(SP_DEVICE_INTERFACE_DATA);
    42.       bMoreItems:=SetupDiEnumDeviceInfo(
    43.         h,
    44.         nIndex,
    45.         @devinfo
    46.         );
    47.       if(bMoreItems)then
    48.         begin
    49.         hDeviceKey:=SetupDiOpenDevRegKey(
    50.            h,
    51.            @devinfo,
    52.            DICS_FLAG_GLOBAL,
    53.            0,
    54.            DIREG_DEV,KEY_QUERY_VALUE);
    55.         item.name:='';
    56.         item.DevDesc:='';
    57.         item.PortClass:=PortClass;
    58.         if(hDeviceKey>0)then
    59.           begin
    60.           szData[0]:=#0;
    61.           dwSize:=sizeof(szData);
    62.           dwType:=0;
    63.           if(RegQueryValueEx(
    64.               hDeviceKey,
    65.               'PortName',
    66.               nil,
    67.               @dwType,
    68.               @szData,
    69.               @dwSize)=0)and(dwSize>=2)then
    70.                  item.name:=szData;
    71.           RegCloseKey(hDeviceKey);
    72.           end;
    73.         if(item.name<>'')then
    74.           begin
    75.           szData[0]:=#0;
    76.           dwSize:=sizeof(szData);
    77.           dwType:=0;
    78.           if(SetupDiGetDeviceRegistryPropertyW(
    79.               h,
    80.               @devinfo,
    81.               SPDRP_DEVICEDESC,
    82.               dwType,
    83.               szData,
    84.               dwSize,
    85.               dwSize))and(dwType = REG_SZ)then
    86.                 item.DevDesc:=szData;
    87.           FItems.Add(item);
    88.           end;
    89.         end;
    90.       inc(nIndex);
    91.       end;
    92.     result:=true;
    93.   finally
    94.     SetupDiDestroyDeviceInfoList(h);
    95.   end;
    96. end;

    Вызываем следующим образом:

    1. FItems.Clear;
    2. EnumPortsSetupAPI(GUID_DEVICEINTERFACE_COMPORT,pcComPort);
    3. EnumPortsSetupAPI(GUID_DEVICEINTERFACE_MODEM,pcModem);

    Плюс ко всему, необходим pas-файл для библиотеки SETUPAPI.dll

    Плюсы очевидны – работает быстро, стабильно, мы получаем всю необходимую информацию об устройстве, не требует прав администратора.

    Минус единственный – для новичка непонятен код.

    Выводы

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

    Автор: Консерв в Delphi

    Комментарии

    02.07.2014 12:42:24
    Avatar of Юрий ГалинЮрий Галин
    Не буду повторно писать свой комментарий, злая капча.
    02.07.2014 09:52:05
    Avatar of КонсервКонсерв
    @Юрий Галин
    У тебя же есть аккаунт. Залогинься и забудь о капче.
    16.08.2014 10:09:05
    Avatar of 202202
    Спасибо за статью
    17.08.2014 02:26:33
    Avatar of КонсервКонсерв
    @202 Пожалуйста! :-)
    05.10.2014 08:05:25
    Avatar of OlegOleg
    А где взять Windows Driver Kit?
    В каком USES ?
    06.10.2014 03:05:56
    Avatar of КонсервКонсерв
    @Oleg
    Заголовочную библиотеку можно загуглить по названию любой функции.

    На днях скину рабочий пример.
    07.10.2014 12:31:33
    Avatar of АндрейАндрей
    Метод 1, однозначно, неприемлем.

    Успешно пользуюсь методом 2 под Vista+ x64 без прав администратора. Просто ключ нужно открывать только на чтение (reg.OpenKeyReadOnly)

    Метод 3, насколько я понимаю, чуть более продвинут, чем метод 2, т.к. тоже получает данные из реестра, только из других ключей.

    Было бы интересно почитать как определить свободен ли COM-порт (с этим вроде как понятно) и, если занят, то каким приложением (это уже интересно).
    08.10.2014 10:08:32
    Avatar of КонсервКонсерв
    @Андрей
    Я долгое время пользовался методов 2, пока не встретился с нюансами во всяких Home версиях. Главные плюсы метода 3 - он работает безукоризненно и даёт более информативную картину.

    Process Explorer показывает открытые файлы (а значит и COM-порты) и их хендлы. Можно покопать в его сторону или поискать решение на MSDN.
    27.10.2014 08:34:07
    Avatar of СтаниславСтанислав
    А что такое TPortClass и TComPortInfo? Самописные какие-то классы? В сети нет упоминания о таких...
    27.10.2014 09:12:03
    Avatar of СтаниславСтанислав
    И, кстати, под XE5 не компилируется, ругается на несовпадение типов h и значения ф-ции SetupDiGetClassDevs, а также на неверный тип devinfo : SP_DEVICE_INTERFACE_DATA; который он хочет как SP_DEVINFO_DATA... Может, нужен какой-то особенный SetupApi.pas?
    27.10.2014 09:33:14
    Avatar of СтаниславСтанислав
    При попытке компиляции из D2007 получил следующие ошибки:
    E2010 Incompatible types: 'Cardinal' and 'Pointer' - строка 26
    E2010 Incompatible types: 'Pointer' and 'Cardinal' - строка 42
    E2033 Types of actual and formal var parameters must be identical - строка 42
    E2010 Incompatible types: 'Pointer' and 'Cardinal' - строка 49
    E2010 Incompatible types: 'Pointer' and 'Cardinal' - строка 78
    E2010 Incompatible types: 'PByte' and 'Array' - строка 78
    E2010 Incompatible types: 'Pointer' and 'Cardinal' - строка 94
    05.11.2014 02:56:09
    Avatar of КонсервКонсерв
    @Станислав
    Да, класы самописные. На днях вырежу из готового проекта небольшой пример и закину исходник.

    SetupApi тоже закину.
    17.12.2014 08:04:54
    Avatar of АлександрАлександр
    Извините, а можно рабочий пример?
    вроде как уже месяц прошел )
    01.04.2015 06:15:04
    Avatar of СергейСергей
    Добрый день!
    Выложите пример реализации вашего функционала! Есть задача, а ваш пример её решает как нельзя лучше !
    Заранее благодарен !
    02.04.2015 05:21:24
    Avatar of СергейСергей
    Пришлось писать самому (не без помощи данность статьи,конечно)

    Выложу, может кому еще надо:
    Получилось примерно так:

    // Юнит с нашими функциями
    unit detectmodems;

    interface

    uses
    Windows, SysUtils, Forms, SETUPAPI;

    type
    TGUIDDeviceInfo = record
    name: string;
    portname: string;
    portnumber: integer;
    end;

    TDevices = array of TGUIDDeviceInfo;

    function GetGUIDdevice ():TDevices;

    implementation

    function GetGUIDdevice ():TDevices;
    var
    Guid : TGUID;
    PnPHandle: HDevInfo;
    DeviceInfoData : SP_DEVINFO_DATA;
    DeviceInterfaceData: SP_DEVICE_INTERFACE_DATA;
    i : Cardinal;
    Success: LongBool;
    DataT, buffersize: Cardinal;
    buffer : PByte;
    //
    hDeviceKey : HKEY;

    szData : array[0..255]of Char;
    dwType,dwSize : DWORD;
    //

    Const
    Modems : TGUID = '{4d36e96d-e325-11ce-bfc1-08002be10318}';
    ComLpt : TGUID = '{4d36e978-e325-11ce-bfc1-08002be10318}';
    begin

    Guid:=Modems;


    PnPHandle:= SetupDiGetClassDevs(@Guid, nil, 0, DIGCF_PRESENT);


    Try
    i:= 0;
    DeviceInfoData.cbSize:= SizeOf(SP_DEVINFO_DATA);
    DeviceInterfaceData.cbSize := SizeOf(SP_DEVICE_INTERFACE_DATA);
    Repeat
    Success:= SetupDiEnumDeviceInfo(PnPHandle, i, DeviceInfoData);

    If Success then
    begin
    buffer:= nil;
    buffersize:= 0;

    while not SetupDiGetDeviceRegistryProperty(PnPHandle,DeviceInfoData,SPDRP_DEVICEDESC,@DataT,buffer,buffersize,@buffersize)
    do begin
    if (GetLastError() = ERROR_INSUFFICIENT_BUFFER) then
    begin
    if (buffer <> nil) then FreeMem(buffer);
    buffer:= AllocMem(buffersize);
    end
    else
    begin
    break;
    end;
    end;

    //ListBox1.Items.Add(Format('%d: %s',[i, StrPas(PChar(buffer))]));
    SetLength(Result,i+1);
    Result[i].name:=StrPas(PChar(buffer));
    if (buffer <> nil) then FreeMem(buffer);
    // Ïûòàåìñÿ íîìåð ïîðòà îïðåäåëèòü

    hDeviceKey:=SetupDiOpenDevRegKey(PnPHandle,DeviceInfoData, DICS_FLAG_GLOBAL,0,DIREG_DEV,KEY_QUERY_VALUE);
    if(hDeviceKey>0)then
    begin

    szData[0]:=#0;
    dwSize:=sizeof(szData);
    dwType:=0;
    if(RegQueryValueEx(hDeviceKey,'PortName',nil,@dwType,@szData,@dwSize)=0)and(dwSize>=2)then
    Result[i].portname:=szData;
    Result[i].portnumber:=StrToInt(StringReplace(szData, 'COM', '',[rfReplaceAll, rfIgnoreCase]));
    RegCloseKey(hDeviceKey);
    end;

    // Ïûòàåìñÿ íîìåð ïîðòà îïðåäåëèòü


    End;
    Inc(i);
    Application.ProcessMessages;
    until not Success;


    Finally
    SetupDiDestroyDeviceInfoList(PnPHandle);
    End;
    end;

    end.


    --------------------

    Вызов примерно так:

    procedure TMain.sBitBtn2Click(Sender: TObject);
    var
    mas:TDevices;
    i:integer;
    begin
    mas:=GetGUIDdevice();

    for i:=0 to Length(mas)-1 do
    begin
    sListBox1.Items.Add(intToStr(i+1)+' '+mas[i].name+' '+mas[i].portname+' '+IntToStr(mas[i].portnumber));
    end;

    end;
    01.07.2015 10:47:45
    Avatar of КонсервКонсерв
    @Сергей
    Спасибо за поддержку :-).
    Я так заработался, что совсем блог забросил.
    03.10.2015 04:29:39
    Avatar of ГригорийГригорий
    Хотелось бы увидеть TPortClass и TComPortInfo, для полноты картины!
    08.10.2015 07:43:40
    Avatar of maxmax
    с нетерпением ждем TPortClass и TComPortInfo, а также SetupApi!
    31.01.2016 03:57:03
    Avatar of МракМрак
    Модуль то найти можно для setupapi.dll, но они все имеют разные названия переменных и не все функции.
    01.03.2016 12:16:34
    Avatar of КонстантинКонстантин
    Метод оказался неработоспособным в случаях, когда виртуальные COM-порты не отображаются в диспетчере задач.
    01.03.2016 12:49:24
    Avatar of КонсервКонсерв
    @Константин
    Вы, наверное, имели в виду диспетчер устройств?

    Ни разу не видел, чтобы были COM-порты, которых нет в диспетчере устройств...
    02.03.2016 07:39:15
    Avatar of КонстатнтинКонстатнтин
    Да, диспетчер устройств, извиняюсь. А такое бывает. Впервые я столкнулся с таким при использовании преобразователя Ethernet - RS-485. Там ставится утилита, которая создает виртуальные COM-порты, но их не видно в диспетчере задач. Однако они есть и программное обеспечение с ними абсолютно нормально работает. Другой пример - программа Virtual Serial Port Emulator. Я её использую, как эмулятор нуль-модема. Она создает два виртуальных com-порта, и связывает их меж собой. Таким образом между собой общаются два приложения. Так вот, эти порты тоже не видны в диспетчере устройств. Кстати, первые два способа, озвученные Вами, эти порты определяют нормально.
    02.03.2016 03:19:36
    Avatar of КонсервКонсерв
    @Констатнтин
    Интересно, буду в курсе.

    Третий способ - это и есть, по сути, то, что использует диспетчер устройств.

    Весьма странно, что есть устройство, но его нет в диспетчере устройств...
    23.03.2016 03:20:12
    Avatar of ЕвгенийЕвгений
    Короче полезность материала без SetupApi.pas который использовал автор вызывает очень большие сомнения, по крайней мере у меня не заработало как бы я ни старался. По поводу кода, который опубликовал Сергей та же ситуация. Прошло столько времени с момента создания топика, а обещания выложить рабочий пример так и остались обещаниями...
    26.04.2016 02:53:40
    Avatar of ГригорийГригорий
    Да , виртуальные COM порты не видит
    28.05.2016 05:21:14
    Avatar of AndrewTishkinAndrewTishkin
    Так и не понял, почему в статье используется GUID_DEVICEINTERFACE_COMPORT, но при этом на скриншоте обведены устройства из класса ports, имеющего совсем другой GUID = {4D36E967-E325-11CE-BFC1-08002BE10318}

    А если гаджет попал в другую категорию - смотрите GUID класса в диспетчере устройств на вкладке "Сведения".

    Ну и касаясь темы статьи - не поминается ещё один способ, минус которого только в отсутствии названий найденных портов. Имеется в виду получение полного списка девайсов через QueryDosDevice и далее вычленение из него строк, начинающихся с COM.

    Справедливости ради, есть и ещё способы
    http://stackoverflow.com/questions/1388871/how-do-i-get-a-list-of-available-serial-ports-in-win32/1394301#1394301

    http://naughter.com/enumser.html
    Internally the CEnumerateSerial provides 9 different ways (yes you read that right: Nine) of enumerating serial ports: Using CreateFile, QueryDosDevice, GetDefaultCommConfig, two ways using the Setup API, EnumPorts, WMI, Com Database & enumerating the values under the registry key HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM.
    Captcha Обновить
    | Регистрация
    Карта сайта
    Go Top