Enumerar puertos seriales en Windows con Lazarus

Versión en ingles

Como tengo solo puertos USB en mi máquina de desarrollo, es muy común que al conectar un dispositivo serial tengo que ir al administrador de dispositivos para ver en que puerto COM se instaló.


Estoy desarrollando una aplicación que necesita acceder a un dispositivo serial, por lo que necesito hacerlo consciente de los puertos COM instalados, ya sea para indicar cual usar o para verificar la existencia del que ya fue configurado.


Investigando un poco para no reinventar la rueda, me encontré con esta página: http://www.lazarus.freepascal.org/index.php?topic=14313.0 donde se publican tres funciones muy interesantes.


La primera función GetSerialPortNames es extraida del paquete synaser (http://synapse.ararat.cz/doku.php/download), devuelve los puertos COM instalados en el sistema operativo (en mi caso: COM3 y COM17). Mas o menos lo que necesito, pero solo los enumera sin identificarlos. 

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;

La segunda función GetSerialPortRegNames es una variante de la primera en la que se muestra el dispositivo instalado en si (en mi caso: \Device\ProlificSerial0 y \Device\USBSER000), lo que tampoco es muy claro.

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;

La última función GetComPortList busca la información en otra parte del registro y obtiene el nombre común (FriendlyName) del puerto instalado, que es justamente lo que estoy queriendo. 

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;

Pero hay un problema con esta última función, busca la información solo en HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\SerEnum. Para probar conecté dos dispositivos seriales un adaptador USB-RS232 genérico y un celular Blu Samba Q, uno de ellos figura en la hoja SerEnum pero la otra aparece bajo UsbSer, lo que me hace suponer que dependiendo de cómo está programado el driver del dispositivo, el nombre del servicio que los controla es arbitrario por lo tanto su ubicación en el árbol HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services también.


Para resolver mi problema tomé como ejemplo la primera y la tercera función e hice la mía propia.

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;

La función busca los puertos COM enumerados en HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM, luego busca recursivamente  en HKEY_LOCAL_MACHINE\System\CurrentControlSet\Enum\ por el nombre común (FriendlyName) del dispositivo. Devuelve algo así: "COM3 = Prolific USB-to-Serial Comm Port (COM3)","COM17 = MTK6225 USB Modem Driver (COM17)"