ports abfragen ?

Für Fragen zur Programmiersprache auf welcher Lazarus aufbaut
Antworten
yodi
Beiträge: 22
Registriert: So 11. Jan 2015, 06:40
OS, Lazarus, FPC: Winux (L 0.9.xy FPC 2.2.z)
CPU-Target: xxBit
Wohnort: bei Göttingen
Kontaktdaten:

ports abfragen ?

Beitrag von yodi »

hi,
gibt es eine Möglichkeit abzufragen welche ports vorhanden sind ? Die ich dann in einer combobox einlesen kann.
Also com1
com 2
com3 USW.

Flotte Grüße
--------

wp_xyz
Beiträge: 5156
Registriert: Fr 8. Apr 2011, 09:01

Re: ports abfragen ?

Beitrag von wp_xyz »

Die Unit synaser aus der synapse-Bibliothek (http://synapse.ararat.czy) stellt eine Funktion GetSerialPortNames() zur Verfügung, die die durch Komma getrennten Schnittstellennamen enthält.

marcov
Beiträge: 1102
Registriert: Di 5. Aug 2008, 09:37
OS, Lazarus, FPC: Windows ,Linux,FreeBSD,Dos (L trunk FPC trunk)
CPU-Target: 32/64,PPC(+64), ARM
Wohnort: Eindhoven (Niederlande)

Re: ports abfragen ?

Beitrag von marcov »

Ich benutzte einen Variante derselben Technik um auch Umschreibungen dazu zu bekommen und auch schon belegte Porten und (typisch virtuelle) serial Ports die nicht mit "COM" anfangen daraus zu filtern.

TStringStringMap ist ein TDictionary<string,string> in neueren delphis, und sorted tstringlist mit ^ record s:string; end; in .objects[] bevor.

Code: Alles auswählen

 
procedure SetupEnumAvailableComPorts(var comlist:TStringStringMap);
// Enumerates all serial communications ports that are available and ready to
// be used.
 
// For the setupapi unit see
// http://homepages.borland.com/jedi/cms/modules/apilib/visit.php?cid=4&lid=3
 
var
  RequiredSize:             Cardinal;
  GUIDSize:                 DWORD;
  Guid:                     TGUID;
  DevInfoHandle:            HDEVINFO;
  DeviceInfoData:           TSPDevInfoData;
  MemberIndex:              Cardinal;
  PropertyRegDataType:      DWord;
  RegProperty:              Cardinal;
  RegTyp:                   Cardinal;
  Key:                      Hkey;
  Info:                     TRegKeyInfo;
  S1,S2:                    string;
  hc:                       THandle;
begin
  comlist.Clear;
//If we cannot access the setupapi.dll then we return a nil pointer.
  if not LoadsetupAPI then exit;
  try
// get 'Ports' class guid from name
 
    GUIDSize := 1;    // missing from original code - need to tell function that the Guid structure contains a single GUID
    if SetupDiClassGuidsFromName('Ports',@Guid,GUIDSize,RequiredSize) then begin
//get object handle of 'Ports' class to interate all devices
       DevInfoHandle:=SetupDiGetClassDevs(@Guid,Nil,0,DIGCF_PRESENT);
       if Cardinal(DevInfoHandle)<>Invalid_Handle_Value then begin
         try
           MemberIndex:=0;
//iterate device list
           repeat
             FillChar(DeviceInfoData,SizeOf(DeviceInfoData),0);
             DeviceInfoData.cbSize:=SizeOf(DeviceInfoData);
//get device info that corresponds to the next memberindex
             if Not SetupDiEnumDeviceInfo(DevInfoHandle,MemberIndex,DeviceInfoData) then
               break;
//query friendly device name LIKE 'BlueTooth Communication Port (COM8)' etc
             RegProperty:=SPDRP_FriendlyName;{SPDRP_Driver, SPDRP_SERVICE, SPDRP_ENUMERATOR_NAME,SPDRP_PHYSICAL_DEVICE_OBJECT_NAME,SPDRP_FRIENDLYNAME,}
 
             SetupDiGetDeviceRegistryProperty(DevInfoHandle,
                                                   DeviceInfoData,
                                                   RegProperty,
                                                   PropertyRegDataType,
                                                   NIL,0,RequiredSize);
             SetLength(S1,RequiredSize);
 
             if SetupDiGetDeviceRegistryProperty(DevInfoHandle,DeviceInfoData,
                                                 RegProperty,
                                                 PropertyRegDataType,
                                                 @S1[1],RequiredSize,RequiredSize) then begin
               KEY:=SetupDiOpenDevRegKey(DevInfoHandle,DeviceInfoData,DICS_FLAG_GLOBAL,0,DIREG_DEV,KEY_READ);
               if key<>INValid_Handle_Value then begin
                 FillChar(Info, SizeOf(Info), 0);
//query the real port name from the registry value 'PortName'
                 if RegQueryInfoKey(Key, nil, nil, nil, @Info.NumSubKeys,@Info.MaxSubKeyLen, nil, @Info.NumValues, @Info.MaxValueLen,
                                                        @Info.MaxDataLen, nil, @Info.FileTime) = ERROR_SUCCESS then begin
                   RequiredSize:= Info.MaxValueLen + 1;
                   SetLength(S2,RequiredSize);
                   if RegQueryValueEx(KEY,'PortName',Nil,@Regtyp,@s2[1],@RequiredSize)=Error_Success then begin
                     If (Pos('COM',S2)=1) then begin
//Test if the device can be used
                       hc:=CreateFile(pchar('\\.\'+S2+#0),
                                      GENERIC_READ or GENERIC_WRITE,
                                      0,
                                      nil,
                                      OPEN_EXISTING,
                                      FILE_ATTRIBUTE_NORMAL,
                                      0);
                       if hc<> INVALID_HANDLE_VALUE then begin
                         comlist.Add(Strpas(PChar(S2)),StrPas(PChar(S1)));
                         CloseHandle(hc);
                       end;
                     end;
                   end;
                 end;
                 RegCloseKey(key);
               end;
             end;
             Inc(MemberIndex);
           until False;
//           end
         finally
           SetupDiDestroyDeviceInfoList(DevInfoHandle);
         end;
       end;
    end;
  finally
    UnloadSetupApi;
  end;
end;
 
Zuletzt geändert von Lori am Do 22. Jan 2015, 19:56, insgesamt 1-mal geändert.
Grund: richtiger Highlighter

Antworten