На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
! Друзья, соблюдайте, пожалуйста, правила форума и данного раздела:
Данный раздел не предназначен для вопросов и обсуждений, он содержит FAQ-заготовки для разных языков программирования. Любой желающий может разместить здесь свою статью. Вопросы же задавайте в тематических разделах!
• Если ваша статья может быть перенесена в FAQ соответствующего раздела, при условии, что она будет оформлена в соответствии с Требованиями к оформлению статей.
• Чтобы остальным было проще понять, указывайте в описании темы (подзаголовке) название языка в [квадратных скобках]!
Модераторы: Модераторы
  
> Перечисление портов последовательного доступа (COM port enumeration), [Delphi] D2010, WMI
    Перечисление последовательных портов

    Вообще говоря, это просто сервис: показать список имеющихся COM портов, для выбора.

    На мой взгляд проще всего это сделать через WMI. Для этого сначала требуется получить (не создать!) COM-объект по URI 'winmgmts:\\.\root\CIMV2' и запросить у него список портов, с помощью запроса. '\\.' на самом деле здесь текуший компьютер, можно указать имя другой рабочей станции, но это уже требует привилегий администратора.
    Далее у WMI надо запросить список портов, делается это запросом к объекту Win32_SerialPort: 'SELECT * FROM Win32_SerialPort', который возвращает коллекцию, описывающую именно serial ports.
    Остается только пройти по коллекции и обратиться к свойствам ее элементов, в частности caption выдает читаемое имя порта, а DeviceID - его имя, COM1, COM2 и т.д.
    Разумеется, в современных версиях Delphi удобно создать нумератор для прохода по этой коллекции.
    Собственно, это все, что нужно сделать, исходник короткий, я соединяюсь с WMI поздним связыванием, поэтому моуль получился автономным:
    ExpandedWrap disabled
      unit EnumSerialPorts;
      {
        Модуль перечисления последовательных портов.
        Используется WMI, берется минимальная информация.
        $Author: Roman $
        $Date:: 2012-02-21 15:37:00#$
      }
       
      interface
       
      uses SysUtils, Generics.Collections, ActiveX;
       
      type
        TSerialPortInfo = record
          Caption: string;
          DeviceID: string;
          MaxBaudRate: cardinal;
          ProviderType: string;
        end;
       
        TSerialPortEnum = class(TEnumerable<TSerialPortInfo>)
        strict private
          FWMIService: Variant;
        protected
          function DoGetEnumerator: TEnumerator<TSerialPortInfo>; override;
          type
            TPortEnum = class(TEnumerator<TSerialPortInfo>)
            strict private
              FEnum: IEnumVARIANT;
              FCurrentElem: OleVariant;
            protected
              function DoGetCurrent: TSerialPortInfo; override;
              function DoMoveNext: Boolean; override;
            public
              constructor Create(Enum: IEnumVariant);
              destructor Destroy; override;
            end;
        public
          constructor Create;
          destructor Destroy; override;
        end;
       
      implementation
       
      uses COMObj, Variants;
       
      //стандартные флаги для запроса
      const
        wbemFlagForwardOnly = $20;
        wbemFlagBidirectional = $0;
        wbemFlagReturnImmediately = $10;
        wbemFlagReturnWhenComplete = $0;
        wbemQueryFlagPrototype = $2;
        wbemFlagUseAmendedQualifiers = $20000;
       
      function GetVariantEnumerator(obj: Variant): IEnumVariant;
      var
        Enum: IUnknown;
      begin
        Enum := obj._NewEnum;
        OleCheck(Enum.QueryInterface(IEnumVariant, Result));
      end;
       
      function GetObject(const ObjName: WideString): Variant;
      var
        Temp: IDispatch;
      begin
        OleCheck(CoGetObject(PWideString(ObjName), nil, IDispatch, @Temp));
        Result := Temp;
      end;
       
      { TSerialPortList }
      const
        strMonName: WideString = 'winmgmts:\\.\root\CIMV2';
        strQueryList: WideString = 'SELECT * FROM Win32_SerialPort';
       
      constructor TSerialPortEnum.Create;
      begin
        inherited;
        FWMIService := GetObject(strMonName);
      end;
       
      destructor TSerialPortEnum.Destroy;
      begin
        FWMIService := Unassigned;
        inherited;
      end;
       
      function TSerialPortEnum.DoGetEnumerator: TEnumerator<TSerialPortInfo>;
      var
        Items: OleVariant;
      begin
        Items := FWMIService.ExecQuery(strQueryList, 'WQL', wbemFlagForwardOnly);
        Result := TPortEnum.Create(GetVariantEnumerator(Items));
      end;
       
      { TSerialPortList.TPortEnum }
       
      constructor TSerialPortEnum.TPortEnum.Create(Enum: IEnumVariant);
      begin
        inherited Create;
        FEnum := Enum;
      end;
       
      destructor TSerialPortEnum.TPortEnum.Destroy;
      begin
        FEnum := nil;
        inherited;
      end;
       
      function TSerialPortEnum.TPortEnum.DoGetCurrent: TSerialPortInfo;
      begin
        Result.Caption := FCurrentElem.Caption;
        Result.DeviceID := FCurrentElem.DeviceID;
        Result.MaxBaudRate := FCurrentElem.MaxBaudRate;
        Result.ProviderType := FCurrentElem.ProviderType;
      end;
       
      function TSerialPortEnum.TPortEnum.DoMoveNext: Boolean;
      var
        Fetched: Cardinal;
      begin
        Result := (FEnum.Next(1, FCurrentElem, Fetched) = S_OK);
      end;
       
      end.

    Пример использования:
    ExpandedWrap disabled
      var
        PortInfo: TSerialPortInfo;
        PortEnum: TSerialPortEnum;
      begin
        PortEnum := TSerialPortEnum.Create;
        try
          for PortInfo in PortEnum do
            ComboBox1.Items.Add(PortInfo.DeviceID);
        finally
          PortEnum.Free;
        end;
    Beware the wild rabbit.
      Интересно, а FindFirst/FindNext порты перечисляет? Ни разу не пробовал, но пайпы и мэйлслоты точно прекрасно перечисляет
      Сообщение отредактировано: --Ins-- -
      Фашисты будущего будут называть себя антифашистами. У. Черчилль
        Тоже стало интересно. Накодил:
        ExpandedWrap disabled
          procedure EnumComPorts(Ports: TStrings);
            procedure GetComPort(i: Integer);
            var
              sr: TSearchRec;
            begin
              if FindFirst('\.\COM' + IntToStr(i), FILE_ATTRIBUTE_NORMAL, sr) = 0 then
              begin
                repeat
                  Ports.Add(sr.Name);
                  Inc(i);
                  GetComPort(i);
                until FindNext(sr) <> 0;
                FindClose(sr);
              end;
            end;
          begin
            GetComPort(1);
          end;

        Пример:
        ExpandedWrap disabled
          EnumComPorts(Memo1.Lines);
          Filka
          это не коректный код. вполне возможна ситуация,когда существует ком2, но не существует ком1
          Не каждая серая масса имеет что-то общее с мозгом (с) Станислав Ежи Лец
            Цитата jack128 @
            это не коректный код. вполне возможна ситуация,когда существует ком2, но не существует ком1

            Это да. Правда, у мя работает. Но только с ком1 (хотя комов - четыре). Но это, думаю, сути не меняет.

            Вообще, код конечно пользительный, но его изменить надо бы, ИМХО..
            Кто рано встает, тому целый день спать хочется
              ExpandedWrap disabled
                procedure EnumComPorts(Ports: TStrings);
                const
                  PortsCount = 255;
                var
                  PortNumber: Integer;
                 
                  procedure GetComPort(i: Integer);
                  var
                    sr: TSearchRec;
                  begin
                    if FindFirst('\.\COM' + IntToStr(i), FILE_ATTRIBUTE_NORMAL, sr) = 0 then
                    begin
                      repeat
                        Ports.Add(sr.Name);
                        Inc(i);
                        PortNumber := i;
                        GetComPort(i);
                      until FindNext(sr) <> 0;
                      FindClose(sr);
                    end;
                  end;
                 
                begin
                  PortNumber := 1;
                  while PortNumber < PortsCount do
                  begin
                    GetComPort(PortNumber);
                    Inc(PortNumber);
                  end;
                end;

              Пример:
              ExpandedWrap disabled
                EnumComPorts(Memo1.Lines);
              Сообщение отредактировано: Filka -
              0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
              0 пользователей:


              Рейтинг@Mail.ru
              [ Script Execution time: 0,1137 ]   [ 17 queries used ]   [ Generated: 24.09.18, 05:43 GMT ]