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
ports abfragen ?
-
- 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 ?
--------
Re: ports abfragen ?
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.
-
- 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 ?
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.
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
Grund: richtiger Highlighter