Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »
Страницы: 1 2

Как определить номер COM порта? [D7, WinXP]


KoTangens   (20.08.09 16:23[20]

Первый раз такое вижу. Свою прогу тестили на 7 компах, из них 3 бука. Все работает. Может кто знает в чем дело?


Медвежонок Пятачок ©   (20.08.09 16:42[21]

дело в том, что на тестируемых компах не было портов с номерами 10 и выше


Германн ©   (21.08.09 02:15[22]


> KoTangens   (20.08.09 13:49) [16]
>
> С реестром показалось слишком сложно, сделала циклом. Работает
> отлично.

В общем случае цикл перебора портов с попыткой их открытия - самый лучший вариант. (С учетом Медвежонок Пятачок ©   (20.08.09 16:20) [19]).
Но к сабжу (как он сформулирован) это почти не имеет никакого отношения.


Shein ©   (26.01.11 21:09[23]

Хоть тема и старая, все же добавлю.
Не обязательно сканировать все номера портов, можно только те что зарегистрированы в системе:


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;


Германн ©   (27.01.11 01:47[24]


> Shein ©   (26.01.11 21:09) [23]
>
> Не обязательно сканировать все номера портов, можно только
> те что зарегистрированы в системе:
>

А смысл?
Сканирование всех номеров занимает так мало времени, что нет смысла в написании лишних 22-х строк кода. :)
Тем более, что опираться на данные в реестре всегда палка о двух концах!


brother ©   (27.01.11 08:38[25]

не надо лезть в реестр, я еще в [3] все нормально предложил...


Сергей М. ©   (28.01.11 12:30[26]

Сдается мне что все это можно поиметь и менее извращенным способом - запросом через WMI..

Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_SerialPort")

For Each objItem in colItems
   Wscript.Echo "Binary: " & objItem.Binary
   Wscript.Echo "Description: " & objItem.Description
   Wscript.Echo "Device ID: " & objItem.DeviceID
   Wscript.Echo "Maximum Baud Rate: " & objItem.MaxBaudRate
   Wscript.Echo "Maximum Input Buffer Size: " & objItem.MaximumInputBufferSize
   Wscript.Echo "Maximum Output Buffer Size: " & _
       objItem.MaximumOutputBufferSize
   Wscript.Echo "Name: " & objItem.Name
   Wscript.Echo "OS Auto Discovered: " & objItem.OSAutoDiscovered
   Wscript.Echo "PNP Device ID: " & objItem.PNPDeviceID
   Wscript.Echo "Provider Type: " & objItem.ProviderType
   Wscript.Echo "Settable Baud Rate: " & objItem.SettableBaudRate
   Wscript.Echo "Settable Data Bits: " & objItem.SettableDataBits
   Wscript.Echo "Settable Flow Control: " & objItem.SettableFlowControl
   Wscript.Echo "Settable Parity: " & objItem.SettableParity
   Wscript.Echo "Settable Parity Check: " & objItem.SettableParityCheck
   Wscript.Echo "Settable RLSD: " & objItem.SettableRLSD
   Wscript.Echo "Settable Stop Bits: " & objItem.SettableStopBits
   Wscript.Echo "Supports 16-Bit Mode: " & objItem.Supports16BitMode
   Wscript.Echo "Supports DTRDSR: " & objItem.SupportsDTRDSR
   Wscript.Echo "Supports Elapsed Timeouts: " & _
       objItem.SupportsElapsedTimeouts
   Wscript.Echo "Supports Int Timeouts: " & objItem.SupportsIntTimeouts
   Wscript.Echo "Supports Parity Check: " & objItem.SupportsParityCheck
   Wscript.Echo "Supports RLSD: " & objItem.SupportsRLSD
   Wscript.Echo "Supports RTSCTS: " & objItem.SupportsRTSCTS
   Wscript.Echo "Supports Special Characters: " & _
       objItem.SupportsSpecialCharacters
   Wscript.Echo "Supports XOn XOff: " & objItem.SupportsXOnXOff
   Wscript.Echo "Supports XOn XOff Setting: " & objItem.SupportsXOnXOffSet
Next


Плохиш ©   (28.01.11 17:20[27]


> for i:=255 downto 1  do
>

Зачем начинать перебор с заведомо неиспользуемых номеров? Начните с 1.

2. Это код так погано отформатирован или в нём действительно нет выхода с запоминанием, при нахождении требуемого порта?


Leonid Troyanovsky ©   (28.01.11 19:01[28]

Алаверды!

By Андрей А. Лобанов:

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;

--
Regards, LVT.


Dmitriy   (10.11.11 15:37[29]

вообще-то у каждого usb устройства есть VID и PID
по ним - вполне можно найти имя ком-порта.


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;



SetupAPI.pas - искать в гугле, например у JEDI


Омлет ©   (10.11.11 16:16[30]

Если это FTDI VCP, то у них есть D2XX.dll для работы с USB.


graf   (15.10.13 13:22[31]

У меня function EnumerateUsbCom(VID, PID: Integer; Ports: TStrings): Integer;не заработало видима SetupAPI не тот.
Кому интересно мой вариант процедуры под Delphi 2010 по ссылки
http://www.interface.ru/iservices/messages.asp?forumId=18718&topicId=22
На этом сайте не влезло сильно большое сообщения (тут ограничения 7000 символов)


graf   (15.10.13 13:22[32]

У меня function EnumerateUsbCom(VID, PID: Integer; Ports: TStrings): Integer;не заработало видима SetupAPI не тот.
Кому интересно мой вариант процедуры под Delphi 2010 по ссылки
http://www.interface.ru/iservices/messages.asp?forumId=18718&topicId=22
На этом сайте не влезло сильно большое сообщения (тут ограничения 7000 символов)


zhgen ©   (07.06.18 23:42[33]

Чаще всего,только один СОМ порт имеем.Если читаем еще один,то это и есть наш виртуальный порт.

AnsiString name = "\\HARDWARE\\DEVICEMAP\\SERIALCOMM";
AnsiString value = "";
TRegistry *reg = new TRegistry();
reg->RootKey = HKEY_LOCAL_MACHINE;
TStringList *n=new TStringList;  
reg->OpenKey(name,0);
reg->GetValueNames(n);
value =n->Text;
AnsiString SStr="\n";
int SubStrPos1=value.AnsiPos(SStr);//выделяем из строки второе имя .
value=value.Delete(1,SubStrPos1);
SStr="\r\n";  
SubStrPos1=value.AnsiPos(SStr);
value=value.Delete(SubStrPos1,2);//второе имя
value = reg->ReadString( value);//читаем значение,например- "СОМ42"
value=value.Delete(1,3); //символы номера COM порта - "42",в нашем случае
reg->CloseKey();

пользуемся,примерно так: CommPort1->ComNumber = value.ToInt();


zhgen ©   (08.06.18 12:06[34]

ноутбук заставил добавить(после строки value=value.Delete(1,SubStrPos1);)  проверку:

if(value=="")//если у нас ноут, то имя СОМ порта одно
    {
      value =n->Text; SStr="\r\n";  SubStrPos1=value.AnsiPos(SStr);
       value=value.Delete(SubStrPos1,2);
    }
   else  // для компа имени будет два
     {
       SStr="\r\n";  SubStrPos1=value.AnsiPos(SStr);
       value=value.Delete(SubStrPos1,2);
      }


zhgen ©   (14.06.18 12:04[35]

сообщение о не подключённом  разъеме  потребовало искать устройство в системе по VID PID USB контроллера.Проверил на семерке 32разряда и на восьмерке 64.

 TRegistry *reg = new TRegistry(KEY_READ);
 reg->RootKey = HKEY_LOCAL_MACHINE;
 AnsiString name = "\\HARDWARE\\DEVICEMAP\\SERIALCOMM";
 AnsiString value,ee;
 TStringList *n=new TStringList;
 reg->OpenKey(name,0);
 reg->GetValueNames(n);
 value =n->Text; //здесь имена открытых COM портов в одной строке
 while(value!="")
  {
   int SubStrPos4=value.AnsiPos("\r");
   ee=ee+reg->ReadString( value.SubString(1,SubStrPos4-1))+" ";
   value=value.Delete(1,SubStrPos4+1);
  } //в строке ее находятся значения открытых портов, те COMxx, COMyy итд
 reg->CloseKey();

 HKEY hKey;     //VID_1A86&PID_7523 для моего контроллера
 DWORD i, j;
 DWORD retCode;
 CHAR  Buff[100];
 retCode =RegOpenKey(HKEY_LOCAL_MACHINE,
  "SYSTEM\\CurrentControlSet\\Enum\\USB\\VID_1A86&PID_7523\\", &hKey);
 AnsiString AStr,aa,dd;
 for(i=0,retCode=0;retCode==0; i++)
   {
     retCode = RegEnumKey(hKey,i,Buff,100 );
     if(retCode==0)
       aa=aa+ AnsiString(Buff)+"\n"; //здесь имена подключей для моего контроллера зарегистрированного на разные COM порты
    }
 RegCloseKey(hKey);
 //если усстройств несколько,то имена получать отдельно в разные строки и отдельно обрабатывать далее:
 AnsiString bb,cc;int k=0;
 for(j=1;j<i;j++)
    {
      int SubStrPos2=aa.AnsiPos("\n");
      bb=aa.SubString(1,(SubStrPos2-1));
      aa=aa.Delete(1,(SubStrPos2));
      name="\\SYSTEM\\CurrentControlSet\\Enum\\USB\\VID_1A86&PID_7523\\"+bb;
      reg->OpenKey(name,0);
      TStringList *nn=new TStringList;
      reg->GetValueNames(nn);
      dd = dd+reg->ReadString( "FriendlyName") +"  ";
      reg->CloseKey();
    }
 while(ee!="")
   {
     int SubStrPos3=ee.AnsiPos(" "); cc=ee.SubString(1,SubStrPos3-1);
     k=dd.AnsiPos(cc);
     if(k!=0) {ee="";cc=cc.Delete(1,3);}  //если контроллер подключен к разъему,то строка сс содержит символы его номера
     else  {ee.Delete(1,SubStrPos3+2);}
   }
 if(!k)
   {MessageDlg("device not found!",mtInformation, TMsgDlgButtons() << mbOK, 0);return;}//device = мой контроллер
   //из за этого сообщения и пришлось городить весь огород


Страницы: 1 2 версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо