Enumerate COM ports in Windows with Lazarus

Spanish version

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.

The first function GetSerialPortNames is extracted from the package  synaser (http://synapse.ararat.cz/doku.php/download), returns the COM ports installed on the operating system (in my case: COM3 & COM17). More or less what I need, but only the list without identifying them.

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;

The second function GetSerialPortRegNames is a variant of the first in that shows the devices installed (in my case: \ Device \ ProlificSerial0 & \ Device \USBSER000), which is also not very clear.

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;