Jak sprawdzic aktualna liczbe portow COM w komputerze

0

Witajcie.
W jaki sposob moge sprawdzic/pobrac informacje o aktualnej ilosci portow com w kompie lub innych urzadzen. Chodzi mi o sytuacje kiedy np wypinam z kompa przesciowke USB-rs232 i w Managarze Urzadzen zmienia sie ilosc dostepnych portow com.

Pozdrawiam i wiekie dzieki za kazde info.

0
unit PortList;

interface

uses Windows, Classes;

function CheckOS(var VersionInfo : TOSVersionInfo) : Integer;
procedure GetPortList(Strings : TStrings);

implementation
{$BOOLEVAL OFF}
uses Registry,SysUtils;

function CheckOS(var VersionInfo : TOSVersionInfo) : Integer;
begin
  VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
  if GetVersionEx(VersionInfo) then
    CheckOS := VersionInfo.dwPlatformId
  else
    CheckOS := -1;
end;



procedure GetPortList(Strings : TStrings);
var Reg : TRegistry;

  procedure ScanRegHardware;
  var
    i : integer;
    PortName : string;
    LName : TStringList;
  begin
    if Reg.OpenKeyReadOnly('\hardware\devicemap\serialcomm') then
      begin
        LName := TStringList.Create;
        Reg.GetValueNames(LName);
        for i := 0 to LName.Count - 1 do
          begin
            if Reg.GetDataType(LName.Strings[i]) = rdString then
              begin
                PortName := Reg.ReadString(LName.Strings[i]);
                if Strings.IndexOf(PortName) < 0 then
                  Strings.Add(PortName);
              end
          end;
        LName.Free;
      end
  end;

  procedure ScanRegEnum(Key : String);
  var
    LKey : TStringList;
    LName : TStringList;
    i : Integer;
    Driver, PortName : String;
    PortSubClass : Byte;
  begin
    if not Reg.OpenKeyReadOnly(Key) then
      Exit;
    LName := TStringList.Create;
    Reg.GetValueNames(LName);
    i := LName.IndexOf('class');
    if i >= 0 then
      begin
        if (Reg.GetDataType('class') = rdString) and
           ((LowerCase(Reg.ReadString('class')) = 'ports') or
            (LowerCase(Reg.ReadString('class')) = 'modem')) and
           (Reg.GetDataType('driver') = rdString) and
           (Reg.GetDataType('portname') = rdString) then
          begin
            Driver := Reg.ReadString('driver');
            PortName := Reg.ReadString('portname');
            if Reg.OpenKeyReadOnly('\System\CurrentControlSet\Services\Class\'+ Driver) and
               (Reg.ReadBinaryData('PortSubClass',PortSubClass,1) = 1) and
               ((PortSubClass = 1) or 
                (PortSubClass = 2)) and
               (Strings.IndexOf(PortName) < 0) then
                 Strings.Add(PortName);
          end
      end;
    LName.Free;
    Reg.OpenKeyReadOnly(Key);
    if Reg.HasSubKeys then
      begin
        LKey := TStringList.Create;
        Reg.GetKeyNames(LKey);
        for i := 0 to LKey.Count - 1 do
          begin
            ScanRegEnum(Key + '\' + LKey[i]);
          end;
        LKey.Free;
      end;
  end;

var
  VersionInfo : TOSVersionInfo;
begin
  if CheckOS(VersionInfo) > 0 then
    if VersionInfo.dwMajorVersion >= 4 then
      begin
        Reg := TRegistry.Create;
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        if VersionInfo.dwMajorVersion > 4 then
          ScanRegHardware //Win 2k, XP
        else if VersionInfo.dwMinorVersion > 0 then
          ScanRegEnum('\enum') //Win9x, mE
        else
          ScanRegHardware; //WinNT
        Reg.Free;
      end;
end;

end.
0

Jest do tego komponent w pakiecie z TComPort ;>
To jest ComboBox, który pokazuje dostępne porty.

0

Wiem ;-)

0

Dzieki za odzew.
Dzisiaj sprawdze to co napisaliscie. Tak na pierwszy rzut oka, ja nie mam w rejestrze tej gałęzi
HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class
a porty COM ktore pokazane sa w tej gałęzi
HKEY_LOCAL_MACHIN\hardware\devicemap\serialcomm
nie uaktualniaja sie po np wypieciu przejsciowki USB-RS232.
Chodzi mi o to zeby w jakims miejscu w rejestrze byla aktualna informacja o portach.
Poniewaz cala sprawa dotyczy modemu na USB ktory obslugiwany jest przez wirtualny port COM, poszukalem troche w rejetrze i jedynie znalazlem gałąź ktora na bieŻąco (Boże, widzisz takie błędy i nie grzmisz) uaktualnia dostepne modemy w systemie.
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Modem\Enum

0

A przeanalizowałeś ten fragment kodu:

var
  VersionInfo : TOSVersionInfo;
begin
  if CheckOS(VersionInfo) > 0 then
    if VersionInfo.dwMajorVersion >= 4 then
      begin
        Reg := TRegistry.Create;
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        if VersionInfo.dwMajorVersion > 4 then
          ScanRegHardware //Win 2k, XP
        else if VersionInfo.dwMinorVersion > 0 then
          ScanRegEnum('\enum') //Win9x, mE
        else
          ScanRegHardware; //WinNT
        Reg.Free;
      end;
end;

podpowiedź: zwróć uwagę na komentarze. Od lat używam tego kodu, działa również pod vistą.

1 użytkowników online, w tym zalogowanych: 0, gości: 1