COM Ports im System auslesen

[christian.noeding]

Naja, das Senden/Empfangen ist mit einer einzigen Komponente ja schnell gemacht.

Ich habe im Anhang zwei Komponenten beigepackt, die sehr zuverlässig funktionieren und alle nötigen Funktionen sehr einfach bereitstellen.

CPort 3.10 von Dejan Crnila

und

TCommPort32 2.1 von Marco Cocco


Viel Erfolg,
Christian

[Moony]

Morgen,

1. ich möchte lediglich die Ports aufgelistet bekommen, welche im System angemeldet sind. Die Verbindung bzw. die Übertragung von Daten geschieht später und ganz wo anders.

2. Habe jetzt Soweit kompilieren können, dass zumindest die Jedis im uses sind. Jetzt sagt er, dass folgende Routine unbekannt ist:
GetRegistryPropertyString
Woher kommt diese?

3. Habe die Cport Komponente installiert, um mal reinzu schauen. Klar hat diese mehr Möglichkeiten als der normale AfComPort. Jedoch löst diese Komponente nicht mein Problem, des Auslesens der registrierten COM Ports im System.

Danke &

Gruß, Moony

[Brainshock]

Hab letztens noch diese Funktion gefunden, macht auch was sie soll (Link zum Orginalposting):

Delphi-Quellcode:

procedure EnumComPorts(Ports: TStrings);
var
  KeyHandle: HKEY;
  ErrCode, Index: Integer;
  ValueName, Data: string;
  ValueLen, DataLen, ValueType: DWORD;
  TmpPorts: TStringList;
begin
  ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\SERIALCOMM',
    0, KEY_READ, KeyHandle);

  if ErrCode <> ERROR_SUCCESS then
    raise Exception.Create('Fehler beim Registry öffnen!');

  TmpPorts := TStringList.Create;
  try
    Index := 0;
    repeat
      ValueLen := 256;
      DataLen := 256;
      SetLength(ValueName, ValueLen);
      SetLength(Data, DataLen);
      ErrCode := RegEnumValue(
        KeyHandle,
        Index,
        PChar(ValueName),
        Cardinal(ValueLen),
        nil,
        @ValueType,
        PByte(PChar(Data)),
        @DataLen);

      if ErrCode = ERROR_SUCCESS then
      begin
        SetLength(Data, DataLen - 1);
        TmpPorts.Add(Data);
        Inc(Index);
      end
      else
        if ErrCode <> ERROR_NO_MORE_ITEMS then
          raise Exception.Create('Fehler Registry auslesen!');

    until (ErrCode <> ERROR_SUCCESS) ;

    TmpPorts.Sort;
    Ports.Assign(TmpPorts);
  finally
    RegCloseKey(KeyHandle);
    TmpPorts.Free;
  end;
end;

Die Funktion GetRegistryPropertyString hab ich nur in der TJvHidPnPInfo Klasse der Unit JvHidControllerClass gefunden. Sollte aber stimmen.

Delphi-Quellcode:

function GetRegistryPropertyString(PnPHandle: HDEVINFO;
    const DevData: TSPDevInfoData; Prop: DWORD): string;
  var
    BytesReturned: DWORD;
    RegDataType: DWORD;
    Buffer: array [0..1023] of Char;
  begin
    BytesReturned := 0;
    RegDataType := 0;
    Buffer[0] := #0;
    SetupDiGetDeviceRegistryPropertyA(PnPHandle, DevData, Prop,
      RegDataType, PByte(@Buffer[0]), SizeOf(Buffer), BytesReturned);
    Result := Buffer;
  end;

Gruß,
Matthias

[christian.noeding]

Hallo,


ich hatte die Hilfsfunktionen vergessen zu posten. Damit nicht wieder was fehlt habe ich habe mal ein Beispielprogramm programmiert und an diesen Post angehängt, damit du siehst, wie die einzelnen Funktionen funktionieren...

hier nochmal der benötigte Code:


Benötigte Dateien:

Delphi-Quellcode:

uses
  JwaWinType, SetupApi, Cfg, CfgMgr32

Hilfsfunktionen:

Delphi-Quellcode:

// Delphi wrapper for CM_Get_Device_ID

function GetDeviceID(Inst: DEVINST): string;
var
  Buffer: PTSTR;
  Size: ULONG;
begin
  CM_Get_Device_ID_Size(Size, Inst, 0);
  // Required! See DDK help for CM_Get_Device_ID
  Inc(Size);
  Buffer := AllocMem(Size * SizeOf(TCHAR));
  CM_Get_Device_ID(Inst, Buffer, Size, 0);
  Result := Buffer;
  FreeMem(Buffer);
end;

// Delphi wrapper for SetupDiGetDeviceRegistryProperty

function GetRegistryPropertyString(PnPHandle: HDEVINFO; const DevData: TSPDevInfoData; Prop: DWORD): string;
var
  BytesReturned: DWORD;
  RegDataType: DWORD;
  Buffer: array [0..1023] of TCHAR;
begin
  BytesReturned := 0;
  RegDataType := 0;
  Buffer[0] := #0;
  SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, Prop,
    RegDataType, PByte(@Buffer[0]), SizeOf(Buffer), BytesReturned);
  Result := Buffer;
end;

function ExtractBus(DeviceID: string): string;
begin
  Result := Copy(DeviceID, 1, Pos('\', DeviceID) - 1);
end;

Suchen und Finden der COM-Ports im FormCreate:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
const
  GUID_DEVINTERFACE_COMPORT: TGUID                = '{86e0d1e0-8089-11d0-9ce4-08003e301f73}';
  GUID_DEVINTERFACE_SERENUM_BUS_ENUMERATOR: TGUID = '{4D36E978-E325-11CE-BFC1-08002BE10318}';
var
  PnPHandle: HDEVINFO;
  DevData: TSPDevInfoData;
  DeviceInterfaceData: TSPDeviceInterfaceData;
  FunctionClassDeviceData: PSPDeviceInterfaceDetailData;
  Success: LongBool;
  Devn: Integer;
  BytesReturned: DWORD;
  SerialGUID: TGUID;
  Inst: DEVINST;
  RegKey: HKEY;
  RegBuffer: array [0..1023] of Char;
  RegSize, RegType: DWORD;
  FriendlyName: string;
  PortName: string;
  DeviceDescription: string;
  Bus: string;

  TestHandle : integer;
  i:integer;
begin
  // these API conversions are loaded dynamically by default
  LoadSetupApi;
  LoadConfigManagerApi;

  // enumerate all serial devices (COM port devices)
    SerialGUID := GUID_DEVINTERFACE_COMPORT; // GUID_DEVINTERFACE_SERENUM_BUS_ENUMERATOR;
  PnPHandle := SetupDiGetClassDevs(@SerialGUID, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
  if PnPHandle = Pointer(INVALID_HANDLE_VALUE) then
    Exit;
  Combobox1.Items.BeginUpdate;
  Combobox1.Items.Clear;
  Devn := 0;
  repeat
    DeviceInterfaceData.cbSize := SizeOf(TSPDeviceInterfaceData);
    Success := SetupDiEnumDeviceInterfaces(PnPHandle, nil, SerialGUID, Devn, DeviceInterfaceData);
    if Success then
    begin
      DevData.cbSize := SizeOf(DevData);
      BytesReturned := 0;
      // get size required for call
      SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData, nil, 0, BytesReturned, @DevData);
      if (BytesReturned <> 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
      begin
        // allocate buffer and initialize it for call
        FunctionClassDeviceData := AllocMem(BytesReturned);
        FunctionClassDeviceData.cbSize := SizeOf(TSPDeviceInterfaceDetailData);

        if SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData,
          FunctionClassDeviceData, BytesReturned, BytesReturned, @DevData) then
        begin
          // gives the friendly name of the device as shown in Device Manager
          FriendlyName := GetRegistryPropertyString(PnPHandle, DevData, SPDRP_FRIENDLYNAME);
          // gives a device description
          DeviceDescription := GetRegistryPropertyString(PnPHandle, DevData, SPDRP_DEVICEDESC);
          // now try to get the assigned COM port name
          RegKey := SetupDiOpenDevRegKey(PnPHandle, DevData, DICS_FLAG_GLOBAL, 0, DIREG_DEV, KEY_READ);
          RegType := REG_SZ;
          RegSize := SizeOf(RegBuffer);
          RegQueryValueEx(RegKey, 'PortName', nil, @RegType, @RegBuffer[0], @RegSize);
          RegCloseKey(RegKey);
          PortName := RegBuffer;
          Inst := DevData.DevInst;
          CM_Get_Parent(Inst, Inst, 0);
          Bus := ExtractBus(GetDeviceID(Inst));
          Combobox1.Items.Add(PortName + ' (' + DeviceDescription + ', ' + Bus+')');
        end;
        FreeMem(FunctionClassDeviceData);
      end;
    end;
    Inc(Devn);
  until not Success;
  SetupDiDestroyDeviceInfoList(PnPHandle);
  Combobox1.Items.EndUpdate;

  // unload API conversions
  UnloadSetupApi;
  UnloadConfigManagerApi;

  Combobox2.Clear;
  for i:=1 to 16 do
  begin
    TestHandle := CreateFile(PChar('\\.\COM'+IntToStr(i)),GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,LongInt(0));
    if (TestHandle > 0) then
    begin
      Combobox2.Items.Add('COM'+inttostr(i));
      CloseHandle(TestHandle);
    end;
  end;

  Combobox1.itemindex:=0;
  Combobox2.itemindex:=0;
end;

ciao,
Christian

[Moony]

@Brainshock:
Genau solch eine Funktion habe ich gesucht. Danke, die hat super funktioniert und gibt mir immer die gerade am System registrierten COM Ports zurück. :hello:

@Christian:
ich werde mich bei Gelegenheit mit deiner Routine und den Hilfsfunktionen beschäftigen und schauen ob Sie nicht besser zu nutzen sind. Zur Zeit muß ich schnell mit meinem Programm fertig werden.

Danke an alle Denkanstöße.

Gruß, Moony

[dmuemey]

Hi,

ich verwende immer diese Routine, die ich mir schon lange mal geschrieben habe:

Delphi-Quellcode:

function GetComAvailable: TStrings;
var
  ValueNames: TStrings;
  Res: TStringList;
  i: integer;
  s: string;
begin
  ValueNames := TStringList.Create;
  Res := TStringList.Create;
  with TRegistry.Create do begin
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly('\HARDWARE\DEVICEMAP\SERIALCOMM\') then begin
        GetValueNames(ValueNames);
        for i:=0 to ValueNames.Count-1 do begin
          s := ReadString(ValueNames.Strings[I]);
          if (Pos('COM',UpperCase(s))=1) and (Pos('DEVICE',UpperCase(ValueNames.Strings[i]))<>0) then Res.Add(Trim(s));
          end;
        end;
      finally
      CloseKey;
      Free;
    end;
  end;
  //sortieren
  Res.Sorted := true;
  Result := Res;
end;

Liefert auch zuverlässig alle aktuell vorhandenen Comports. Fie Abfrage auf "DEVICE" im String, wirft mir Modems raus. Aber ich habe keine Ahnung, wie ich die Friendlynames dazu finden soll. Schön wäre es, ich hätte Sie. Vorteil: Ich brauche die ganze Jedi-API nicht.

@Christian: Deine Methode 1 liefert mir Comports nicht, die von USB CDC-Klassen kommen. Bei dieser klasse können mehrere USB-Funktionen an einem Port hängen. Ich habe das im Zusammenhang mit ATMEL-Mikrocontrollern AT90USB162 und ähnlich. Da habe ich dann einen Port mit dem Friendlyname AT90USBxxx CDC USB to UART MGM (COM9), den Deine Methode1 nicht findet (Methode 2 natürlich schon).
Hast Du noch eine Idee, wie man entweder die CDC Klassen auch mit Deinem Code durchsucht, oder bei meiner Methode den Friendlyname noch findet?

Dieter

[Fridolin Walther]

Wie kompliziert das ist ... sollte nicht ein einfaches QueryDosDevice reichen?

Delphi-Quellcode:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows, Classes;

procedure ListDevices(Devices : TStrings; const Filter : string = '');
var
  DevicesBuffer : array of Char;
  CharsWritten  : Integer;
  Device        : string;
  i             : Integer;
begin
  Device := '';
  SetLength(DevicesBuffer, 0);

  repeat
    SetLength(DevicesBuffer, Length(DevicesBuffer) + 1000);
    CharsWritten := QueryDosDevice(nil, @DevicesBuffer[0], Length(DevicesBuffer) - 1)
  until CharsWritten > 0;

  for i := 0 to CharsWritten - 1 do
    if DevicesBuffer[i] = #0 then
      begin
        if (Filter = '') or (Pos(Filter, Device) = 1)  then
          Devices.Add(Device);
        Device := '';
      end
    else
      Device := Device + DevicesBuffer[i];
end;

var
  Devices : TStringList;
begin
  Devices := TStringList.Create;
  ListDevices(Devices, 'COM');
  writeln(Devices.Text);
  readln;
  Devices.Free;
end.

[dmuemey]

Diese Methode funktioniert auch, aber liefert ebenfalls keine Friendly Names und ich habe wieder keine Methode, so was wie ein Modem, das sich hinter einem Comport "versteckt", auszuschließen. Ich arbeite oft mit sehr vielen Comports. Und da wäre eine Info wie "MOXA UPort ComPort8 (COM37)" schon sehr wertvoll, um die Übersicht zu behalten. Friendly Names sind also nicht nur eine nette Zugabe, sie können wirklich helfen.

Meine Anwendung: Ich werte Wettkämpge Gleitschirm- und Drachenfliegen aus. Am Abend kommen 100 Piloten und wollen ihr GPS ausgelesen haben, mit dem der Flug dokumentiert ist. Da manche Protokolle etliche Minuten für den Datentransfer brauchen, braucht man schon viele Ports. Außerdem gibt es so viele verschiedene Protokolle und Anschlusskabel, dass es sinnvoll ist, jedem möglichen Protokoll und Kabel einen Port zuzuordnen. Dann gibt es noch GPS-Geräte, die einen USB-Anschluss haben, hinter dem sich ein eingebauter USB-COM-Wandler versteckt. Auf welcher Portnummer ist denn dieses Gerät jetzt schon wieder...?

Die Methode 1 von Christian findet übrigens auch meinen MOXA UPort (8fach USB-Com-Converter) nicht. Und Methode 2 findet keine Ports, die im Moment von einem Programm belegt sind. Alles noch nicht ganz überzeugend

Dieter

[dmuemey]

Habe mich etwas durch die Registry gewühlt und bekomme so eine Zuordnung aller installierten Com-Devices zu Ihren FriendlyNames in einer Liste. Sieht etwas hässlich aus, geht aber ganz schnell und zeigt alles, was ich bauche.

Delphi-Quellcode:

unit uComNames;

interface

uses Registry, classes, Windows, Dialogs, Sysutils;

function GetComNames: TStrings;

implementation

function GetComNames: TStrings;
var
  KeyNames1,KeyNames2,KeyNames3: TStrings;
  Res: TStringList;
  i,ii,iii: integer;
  s,Key0: string;
begin
  KeyNames1 := TStringList.Create;
  KeyNames2 := TStringList.Create;
  KeyNames3 := TStringList.Create;
  Key0 := '\SYSTEM\CurrentControlSet\Enum\';  
  Res := TStringList.Create;
  with TRegistry.Create do begin
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly(Key0) then begin
        GetKeyNames(KeyNames1);
        for i:=0 to KeyNames1.Count-1 do begin
          OpenKeyReadOnly(Key0+KeyNames1[i]+'\');
          GetKeyNames(KeyNames2);
          for ii:=0 to KeyNames2.Count-1 do begin
            OpenKeyReadOnly(Key0+KeyNames1[i]+'\'+KeyNames2[ii]+'\');
            GetKeyNames(KeyNames3);
            for iii:=0 to KeyNames3.Count-1 do begin
              OpenKeyReadOnly(Key0+KeyNames1[i]+'\'+KeyNames2[ii]+'\'+KeyNames3[iii]+'\');
              if KeyExists('Device Parameters') then begin
               s := ReadString('FriendlyName');
               OpenKeyReadOnly(Key0+KeyNames1[i]+'\'+KeyNames2[ii]+'\'+KeyNames3[iii]+'\Device Parameters\');
               if ValueExists('PortName') then begin
                 s := ReadString('PortName')+'|'+s;
                 if Pos('COM',s)=1 then Res.Add(s+'|'+KeyNames1[i]);
                 end;
               end;
            end;
          end;
        end;
      end;
      finally
      CloseKey;
      Free;
    end;
  end;
  //sortieren
  Res.Sort;
  Result := Res;
end;

end.

[rakekniven]

Zitat:

Zitat von christian.noeding (Beitrag 811957)

Hallo,
ich hatte die Hilfsfunktionen vergessen zu posten. Damit nicht wieder was fehlt habe ich habe mal ein Beispielprogramm programmiert und an diesen Post angehängt, damit du siehst, wie die einzelnen Funktionen funktionieren...

Hallo Christian,

vielen Dank für Dein Beispielprogramm. :cheer:
Bin gerade dabei, die Sache in eine DLL zu packen.
So kann ich vor dem Öffnen des Ports abfragen ob er installiert ist und ob er belegt ist.

Genial wäre noch herauszufinden wer ihn belegt. Da werde ich mal bei Sysinternals nachfragen :wink:

Gruß