As I have only USB ports on my development machine, is quite common at connecting a serial device that I have to go to the device manager to see in which COM port it was installed.
I am developing an application that needs to access a serial device, so I need to get aware of the COM ports installed, either to indicate which to use or to verify the existence of which was already configured.
Researching a bit to not reinvent the wheel, I found this page: http://www.lazarus.freepascal.org/index.php?topic=14313.0 which publishes three interesting functions.
function GetSerialPortNames: string;
var
reg: TRegistry;
l, v: TStringList;
n: integer;
begin
l := TStringList.Create;
v := TStringList.Create;
reg := TRegistry.Create;
try
{$IFNDEF VER100}
reg.Access := KEY_READ;
{$ENDIF}
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKeyReadOnly('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;
function GetSerialPortRegNames: string;
var
reg: TRegistry;
l : TStringList;
n: integer;
begin
l := TStringList.Create;
// v := TStringList.Create;
reg := TRegistry.Create;
try
{$IFNDEF VER100}
reg.Access := KEY_READ;
{$ENDIF}
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM');//, false);
reg.GetValueNames(l);
// for n := 0 to l.Count - 1 do
// l[n]:= l[n]+'='+ reg.ReadString(l[n]);
Result := l.CommaText;
finally
reg.Free;
l.Free;
// v.Free;
end;
end;
The last function GetComPortList seeks information from another part of the registry and gets the common name (FriendlyName) of the device installed, which is what I'm wanting.
function GetComPortList(PortList: TStrings): integer;
var
i,idx: integer;
SerPortNum: integer;
Reg: TRegistry;
EnumList: TStrings;
begin
result := -1;
if not CheckMinOS(osWin2k) then
exit;
Reg := TRegistry.Create();
EnumList := TStringList.Create;
try
// Anzahl der Schnittstellen ermitteln
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKeyReadOnly('\System\CurrentControlSet\Services\SerEnum\Enum') then
begin
SerPortNum := Reg.ReadInteger('Count');
// Registry-Schlüssel der Schnittstellen zwischenspeichern
for i:=0 to SerPortNum-1 do
EnumList.Add(Reg.ReadString(inttostr(i)));
Reg.CloseKey;
// Daten der Schnittstellen ermitteln
for i:=0 to SerPortNum-1 do
begin
// Schnittstellenname ermitteln (z.B. 'COM2')
if Reg.OpenKeyReadOnly('\System\CurrentControlSet\Enum\'+EnumList.Strings[i]+'\Device Parameters') then
idx := PortList.Add(Reg.ReadString('PortName')+'=');
Reg.CloseKey;
// Bezeichnung wie im Gerätemanager ermitteln (z.B. 'USB Serial Port (COM2)' )
if Reg.OpenKeyReadOnly('\System\CurrentControlSet\Enum\'+EnumList.Strings[i]) then
PortList.ValueFromIndex[idx] := Reg.ReadString('FriendlyName');
Reg.CloseKey;
end;
end;
finally
EnumList.Free;
Reg.Free;
end;
result := PortList.Count;
end;
But there is a problem with this last feature, it's looking for the information only in HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\SerEnum. To test I plugged in two serial devices, a generic USB-to-RS232 adapter and a Blu Samba Q cellphone. One of them appears on the sheet SerEnum but the other appears under USBSER, which makes me assume that depending on how it is programmed the device driver, service name is arbitrary and therefore its location in the tree HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services too.
To solve my problem I took as example the first and the third function and made my own.
function GetSerialPortNamesExt: string;
var
reg : TRegistry;
l,v : TStringList;
n : integer;
pn,fn: string;
function findFriendlyName(key: string; port: string): string;
var
r : TRegistry;
k : TStringList;
i : Integer;
ck: string;
rs: string;
begin
r := TRegistry.Create;
k := TStringList.Create;
r.RootKey := HKEY_LOCAL_MACHINE;
r.OpenKeyReadOnly(key);
r.GetKeyNames(k);
r.CloseKey;
try
for i := 0 to k.Count - 1 do
begin
ck := key + k[i] + '\'; // current key
// looking for "PortName" stringvalue in "Device Parameters" subkey
if r.OpenKeyReadOnly(ck + 'Device Parameters') then
begin
if r.ReadString('PortName') = port then
begin
//Memo1.Lines.Add('--> ' + ck);
r.CloseKey;
r.OpenKeyReadOnly(ck);
rs := r.ReadString('FriendlyName');
Break;
end // if r.ReadString('PortName') = port ...
end // if r.OpenKeyReadOnly(ck + 'Device Parameters') ...
// keep looking on subkeys for "PortName"
else // if not r.OpenKeyReadOnly(ck + 'Device Parameters') ...
begin
if r.OpenKeyReadOnly(ck) and r.HasSubKeys then
begin
rs := findFriendlyName(ck, port);
if rs <> '' then Break;
end; // if not (r.OpenKeyReadOnly(ck) and r.HasSubKeys) ...
end; // if not r.OpenKeyReadOnly(ck + 'Device Parameters') ...
end; // for i := 0 to k.Count - 1 ...
result := rs;
finally
r.Free;
k.Free;
end; // try ...
end; // function findFriendlyName ...
begin
v := TStringList.Create;
l := TStringList.Create;
reg := TRegistry.Create;
Result := '';
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if reg.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM') then
begin
reg.GetValueNames(l);
for n := 0 to l.Count - 1 do
begin
pn := reg.ReadString(l[n]);
fn := findFriendlyName('\System\CurrentControlSet\Enum\', pn);
v.Add(pn + ' = '+ fn);
end; // for n := 0 to l.Count - 1 ...
Result := v.CommaText;
end; // if reg.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM') ...
finally
reg.Free;
v.Free;
end; // try ...
end;
