COM Ports im System auslesen

[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

[rakekniven]

Zitat von 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...

Hallo Christian,

vielen Dank für Dein Beispielprogramm.
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

Gruß

[Jakson]

Hallo zusammen

Ich habe gerade untersucht was die Jedi-API so macht und festgestellt das ganze lässt sich ohne die Jedi-API auch bewerkstelligen.

Die Funktion "SetupDiGetClassDevs" ruft auch nur einen definierten Registry Pfad auf und werdet die Daten daraus aus.

Hier meine Unit

Code:

unit SerialPorts;

interface

type
  SerialPort_Rec = record
    PortNr       : Word;
    Linked       : Boolean;
    PortName,
    Description,
    FriendlyName,
    Decive,
    KeyDevice,
    KeyEnum      : String;
  end;
  SerialPort_Ar = Array of SerialPort_Rec;

  function GetComPorts:SerialPort_Ar;

implementation

uses Windows, SysUtils, Classes, Registry;

const Key_Devices = '\SYSTEM\CurrentControlSet\Control\DeviceClasses\{86e0d1e0-8089-11d0-9ce4-08003e301f73}\';
      Key_Enum    = '\SYSTEM\CurrentControlSet\Enum\';

procedure SortComPorts(VAR Daten:SerialPort_Ar);
var Sort_Max,
    Sort_From,
    Sort_To,
    Sort_Size : LongInt;
    TempData  : SerialPort_Rec;
begin
 if Daten = NIL then
  Exit;

 Sort_Max  := High(Daten);
 Sort_Size := Sort_Max shr 1;  { div 2 }
 while Sort_Size > 0 do
  begin
   for Sort_From := 0 to Sort_Max - Sort_Size do
    begin
     Sort_To := Sort_From;
     while (Sort_To >= 0) AND (Daten[Sort_To].PortNr > Daten[Sort_To + Sort_Size].PortNr) do
      begin // Tauschen
       TempData                   := Daten[Sort_To];
       Daten[Sort_To]             := Daten[Sort_To + Sort_Size];
       Daten[Sort_To + Sort_Size] := TempData;
       Dec(Sort_To,Sort_Size);
      end;
    end;
   Sort_Size := Sort_Size shr 1; { div 2 }
 end;
end;

function GetComPorts:SerialPort_Ar;
var Reg          : TRegistry;
    Keys         : TStrings;
    Count,
    Index,
    Linked       : Integer;
    Key1,
    Key2,
    Device,
    Description,
    FriendlyName,
    PortName     : String;
begin
 Result := NIL;
 Reg    := TRegistry.Create;
 Keys   := TStringList.Create;
 try
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  if Reg.OpenKeyReadOnly(Key_Devices) then
   begin
    Reg.GetKeyNames(Keys);
    if Keys.Count > 0 then
     begin
      Index := 0;
      SetLength(Result,Keys.Count);
      for Count := 0 to Keys.Count-1 do
       begin
        Key1 := Key_Devices+Keys[Count] + '\';
        if Reg.OpenKeyReadOnly(Key1) then
         begin
          Device := Reg.ReadString('DeviceInstance');
          Key2   := Key_Enum + Device + '\';
          if Reg.OpenKeyReadOnly(Key1 + '#\Control\') then
           begin
            Linked := Reg.ReadInteger('Linked');
            if Reg.OpenKeyReadOnly(Key2) then
             begin
              if (Reg.ReadString('Class') = 'Ports') AND Reg.KeyExists('Device Parameters') then
               begin
                FriendlyName := Reg.ReadString('FriendlyName');
                Description  := Reg.ReadString('DeviceDesc');
                if Reg.OpenKeyReadOnly(Key2+'\Device Parameters\') AND Reg.ValueExists('PortName') then
                 begin
                  PortName := Reg.ReadString('PortName');
                  if Pos('COM',PortName) = 1 then
                   begin
                    Delete(Description,1,Pos(';',Description));
                    Result[Index].PortNr       := StrToIntDef(Copy(PortName,4),0);
                    Result[Index].Linked       := Linked > 0;
                    Result[Index].PortName     := PortName;
                    Result[Index].Description  := Description;
                    Result[Index].FriendlyName := FriendlyName;
                    Result[Index].Decive       := Device;
                    Result[Index].KeyDevice    := Key1;
                    Result[Index].KeyEnum      := Key2;
                    Inc(Index);
                   end;
                 end;
               end;
             end;
           end;
         end;
       end;
      SetLength(Result,Index);
     end;
   end;
 finally
  Keys.Free;
  Reg.CloseKey;
  Reg.Free;
  SortComPorts(Result);
 end;// finally
end;

end.

[stoxx]

die Funktion funktionierte nicht mehr unter Win8 .. die SetupAPI ist da besser gestellt ...
und Dein Sortieralgorithmus hat definitiv eine Macke.

[ekke]

Zitat von stoxx:

die Funktion funktionierte nicht mehr unter Win8 ..(...)

Unter Win8 etc. muss die Registry selber im READ only Modus geöffnet werden. Mit

Code:

with TRegistry.Create(KEY_READ) do

gehts.

[zeras]

Nur mal so als Info.
Sollte jemand TMS Async haben, dann gibt es da auch eine Funktion. Bei Bedarf melden, dann könnte ich diese raussuchen.

[ekke]

Der Sonntagnachmittag ging mit Aufräumen und der 64-Bit-Adaption für den Code von Christian Nöding drauf.
Ich habe alle MemAlloc rausgebaut und durch dynamische Arrays ersetzt, diverse try..finally eingebaut, das Ganze in eine Klasse gepackt und das Laden und Entladen der nötige DLLs in den Fuß einer Unit.
Jetzt läuft alles schön rund.
Bitte die Kommentare hinsichtlich der 64-Bit Adaption beachten
Anbei der Code.
Viel Spaß damit.

Man braucht ein Form mit einem Knopf und einem Memofeld.

Delphi-Quellcode:

uses
  USerialPortList;

procedure TForm1.Button1Click(Sender: TObject);
var
  portlist : TSerialPortListEnhanced;
begin
  if SerialPortAPIsLoaded then
  begin
    portlist := TSerialPortListEnhanced.Create;
    try
      // Nur die Ports
      // portlist.SimpleList(Memo1.Lines);
      // Ports mit zusätzlichen Informationen
      portlist.SimpleList(Memo1.Lines, [slSymbolicNames, slFriendlyNames]);
      if portlist.PortCount <= 0 then
        Memo1.Lines.Add('No Ports found!');
      if portlist.LastError <> 0 then
        Memo1.Lines.Add(Format('Last Error: %d',[portlist.LastError]));
    finally
      portlist.Free;
    end;
  end
  else
    Memo1.Lines.Add('SetupAPI is not initialized!');
end;

Die Unit UserialPorts.pas sieht wie folgt aus.

Delphi-Quellcode:

unit USerialPortList;
interface
// Autor: Ekkehard Domning ([e-mail])
// Lizenz: Public Domain, aber bitte damit keine Lebewesen quälen oder töten!
// Datum: 2019-02-10
// Die ursprüngliche Idee zu dieser Liste stammt von Christian Nöding
// und ist auf dieser Seite
// https://www.delphipraxis.net/118592-com-ports-im-system-auslesen.html
// zu finden
uses
  System.SysUtils, System.Classes,  Winapi.Windows,
// Jedi SetupAPI
// https://sourceforge.net/projects/jedi-apilib/files/
// Herunterladen und auspacken, keine Installation nötig
// Die Verzeichnisse
//(...)\jwa\branches\2.3\SaCMAPI;
//(...)\jwa\branches\2.3\Includes;
//(...)\jwa\branches\2.3\Common;
//(...)\jwa\branches\2.3\Win32API
// müssen in die Suchpfade eingetragen werden
// Menü Projekt->Optionen,
// dann oben Ziel "Alle Konfigurationen - Alle Plattformen" auswählen,
// dann links "Delphi-Compiler" (oberster Eintrag) auswählen
// dann rechts "Suchpfad" auf "..." klicken und Pfade einzeln raussuchen und eintragen

// ACHTUNG wenn die Zielplattform 64-Bit Windows ist müssen zwei kleine Änderungen
// in "SetupApi.pas" vorgenommen werden, die aber auch zu 32-Bit rückwärtskompatibel sind.
// In den Zeilen 851 und 856 muss jeweils der ULONG_PTR durch Pointer ersetzt werden
//   Reserved: Pointer;
// Dies betrifft die Records SP_DEVINFO_DATA und SP_DEVICE_INTERFACE_DATA
// Diese Änderungen sind nötig um die Größen der Records auf das erforderliche Maß zu bringen
  JwaWinType, SetupApi, Cfg, CfgMgr32;

type
  TSerialPortListEnhancedSimpleListFlag = (slFriendlyNames, slDeviceDescriptions, slSymbolicNames, slBusses);
  TSerialPortListEnhancedSimpleListFlags = set of TSerialPortListEnhancedSimpleListFlag;

  // Class TSerialPortListEnhanced
  // Klasse die Ports erkennt und in eine Struktur bringt.
  TSerialPortListEnhanced = class(TObject)
  private
    FLastError : Integer;
    FPortNames : TStringList;
    FFriendlyNames : TStringList;
    FDeviceDescriptions : TStringList;
    FSymbolicNames : TStringList;
    FBusses : TStringList;
    function GetPortCount : Integer;
    function GetPortNames(Index : Integer) : String;
    function GetFriendlyNames(Index : Integer) : String;
    function GetDeviceDescriptions(Index : Integer) : String;
    function GetSymbolicNames(Index : Integer) : String;
    function GetBusses(Index : Integer) : String;
    procedure Clear;
    procedure Sort;
  public
    property LastError : Integer read FLastError; // Wenn nach Create oder Update der LastError <> 0 ist, ging was schief
    // PortCount enthält Anzahl der gefundenen CommPorts (Schnittstellen). In den nachfolgenden Properties kann von 0 bis PortCount-1 abgefragt werden
    property PortCount : Integer read GetPortCount;
    property PortNames[Index : Integer] : String read GetPortNames; //Namen der gefundenen Ports z.B. 'COM8'
    property FriendlyNames[Index : Integer] : String read GetFriendlyNames; //Anzeigename wie im Devicemanager 'Prolific USB-to-Serial Comm Port (COM8)'
    property DeviceDescriptions[Index : Integer] : String read GetDeviceDescriptions; //zB. 'Prolific USB-to-Serial Comm Port'
    property SymbolicNames[Index : Integer] : String read GetSymbolicNames; // Langer GeräteName, zB '\??\USB#VID_067B&PID_2303#6&1cf66e6e&0&2#{a5dcbf10-6530-11d2-901f-00c04fb951ed}'
    property Busses[Index : Integer] : String read GetBusses; //Bus zB 'USB'
    // Update aktualisiert die Liste, dh die Liste ändert sich dann, wenn Ports hinzugekommen sind oder entfernt wurden
    procedure Update;
    // SimpleList gibt den Inhalt der Liste formatiert zurück
    procedure SimpleList(const Items : TStrings; const Flags : TSerialPortListEnhancedSimpleListFlags = []);
    // Create legt die Liste an und ruft Update auf, damit gleich alle Daten verfügbar sind
    constructor Create;
    destructor Destroy; override;
  end;

// Mit SerialPortAPIsLoaded kann geprüft werden ob die nötigen DLLs geladen wurden
function SerialPortAPIsLoaded : Boolean;

implementation
// Delphi wrapper for CM_Get_Device_ID
function GetDeviceID(const Inst: DEVINST): String;
var
  Size: ULONG;
begin
  CM_Get_Device_ID_Size(Size, Inst, 0);
  // Required! See DDK help for CM_Get_Device_ID
  Inc(Size);
  SetLength(Result,Size);
  CM_Get_Device_ID(Inst, PTSTR(@Result[1]), Size, 0);
end;
// Delphi wrapper for SetupDiGetDeviceRegistryProperty
function GetRegistryPropertyString(const PnPHandle: HDEVINFO; const DevData: TSPDevInfoData; const Prop: DWORD): String;
var
  BytesReturned: DWORD;
  RegDataType: DWORD;
begin
  BytesReturned := 0;
  RegDataType := 0;
  SetLength(Result,512);
  SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, Prop,
    RegDataType, PByte(@Result[1]), Length(Result)*SizeOf(Char), BytesReturned);
  if BytesReturned > 0 then
    SetLength(Result,(BytesReturned div SizeOf(Char))-1) //Abschließende #0 entfernen
  else
    SetLength(Result,0);
end;
function ExtractBus(const ADeviceID: String): String;
var
  posi : Integer;
begin
  Result := ADeviceID;
  posi := Pos('\', ADeviceID) - 1;
  if posi > 0 then
    SetLength(Result,posi);
end;
function TSerialPortListEnhanced.GetPortCount;
begin
  Result := FPortNames.Count;
end;
function TSerialPortListEnhanced.GetPortNames(Index : Integer) : String;
begin
  Result := FPortNames[Index];
end;
function TSerialPortListEnhanced.GetFriendlyNames(Index : Integer) : String;
begin
  Result := FFriendlyNames[Index];
end;
function TSerialPortListEnhanced.GetDeviceDescriptions(Index : Integer) : String;
begin
  Result := FDeviceDescriptions[Index];
end;
function TSerialPortListEnhanced.GetSymbolicNames(Index : Integer) : String;
begin
  Result := FSymbolicNames[Index];
end;
function TSerialPortListEnhanced.GetBusses(Index : Integer) : String;
begin
  Result := FBusses[Index];
end;
procedure TSerialPortListEnhanced.Clear;
begin
  FPortNames.Clear;
  FFriendlyNames.Clear;
  FDeviceDescriptions.Clear;
  FSymbolicNames.Clear;
  FBusses.Clear;
end;
procedure TSerialPortListEnhanced.Sort;
var
  lPortNames : TStringList;
  lDeviceDescriptions : TStringList;
  lSymbolicNames : TStringList;
  lBusses : TStringList;
  lFriendlyNames : TStringList;
  i : Integer;
  ndx : Integer;
begin
  if PortCount < 2 then Exit; // Leere Liste oder nur ein Element, muss nicht sortiert werden
  lPortNames := Nil;
  lFriendlyNames := Nil;
  lDeviceDescriptions := Nil;
  lSymbolicNames := Nil;
  lBusses := Nil;
  try
    lPortNames := TStringList.Create;
    lPortNames.Assign(FPortNames); //Aktuelle Liste sichern
    FPortNames.Sort; // Sortieren
    if FPortNames.Text = lPOrtNames.Text then Exit; // Keine Änderungen, also raus
    // Lokale Listen anlegen
    lFriendlyNames := TStringList.Create;
    lDeviceDescriptions := TStringList.Create;
    lSymbolicNames := TStringList.Create;
    lBusses := TStringList.Create;
    // Gegenwärtige Reihenfolge sichern
    lFriendlyNames.Assign(FFriendlyNames);
    lDeviceDescriptions.Assign(FDeviceDescriptions);
    lSymbolicNames.Assign(FSymbolicNames);
    lBusses.Assign(FBusses);
    // Durch alle Portnamen in alter Reihenfolge laufen
    for i := 0 to lPortNames.Count-1 do
    begin
      ndx := FPortNames.IndexOf(lPortNames[i]); //Index des alten PortNamens in der neuen Reihenfolge suchen
      if ndx <> i then // Wenn nicht am gleichen Platz, dann
      begin // Inhalte kopieren
        FFriendlyNames[ndx] := lFriendlyNames[i];
        FDeviceDescriptions[ndx] := lDeviceDescriptions[i];
        FSymbolicNames[ndx] := lSymbolicNames[i];
        FBusses[ndx] := lBusses[i];
      end;
    end;
  finally
    if Assigned(lPortNames) then
      lPortNames.Free;
    if Assigned(lFriendlyNames) then
      lFriendlyNames.Free;
    if Assigned(lDeviceDescriptions) then
      lDeviceDescriptions.Free;
    if Assigned(lSymbolicNames) then
      lSymbolicNames.Free;
    if Assigned(lBusses) then
      lBusses.Free;
  end;
end;
procedure TSerialPortListEnhanced.Update;
const
  // Drei Positionen wo die Ports sein können
  GUID_DEVINTERFACE_COMPORT: TGUID = '{86e0d1e0-8089-11d0-9ce4-08003e301f73}';
  GUID_DEVINTERFACE_SERENUM_BUS_ENUMERATOR: TGUID = '{4D36E978-E325-11CE-BFC1-08002BE10318}';
  GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
var
  PnPHandle: HDEVINFO;
  DevData: TSPDevInfoData;
  DeviceInterfaceData: TSPDeviceInterfaceData;
  FunctionClassDeviceData: PSPDeviceInterfaceDetailData;
  FunctionClassDeviceDataBuffer : array of Byte;
  Success: LongBool;
  Devn: NativeInt;
  BytesReturned: DWORD;
  SerialGUID: TGUID;
  Inst: DEVINST;
  RegKey: HKEY;
  RegBuffer: array [0..1023] of Char;
  RegSize, RegType: DWORD;
  lFriendlyName: string;
  lPortName: string;
  lDeviceDescription: string;
  lSymbolicName : String;
  lBus: string;
  i : Integer;
  ndx : Integer;
begin
  Clear;
  FLastError := ERROR_SUCCESS;
  SetLength(FunctionClassDeviceDataBuffer,256);

  for i := 0 to 2 do
  begin
    // Einige Port Emulatoren tragen sich nicht als ComPort ein, werden aber als solche benutzt
    case i of
      0 : SerialGUID := GUID_DEVINTERFACE_COMPORT;
      1 : SerialGUID :=  GUID_DEVINTERFACE_SERENUM_BUS_ENUMERATOR;
    else
      SerialGUID := GUID_DEVINTERFACE_USB_DEVICE;
    end;

    PnPHandle := SetupDiGetClassDevs(@SerialGUID, nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);
    if PnPHandle = Pointer(INVALID_HANDLE_VALUE) then
    begin
      FLastError := GetLastError;
      Continue;
    end;
    try
      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
          success := SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData, nil, 0, BytesReturned, @DevData);
          FLastError := GetLastError;
          if (BytesReturned <> 0) and (FLastError = ERROR_INSUFFICIENT_BUFFER) then
          begin
            // allocate buffer and initialize it for call
            if Length(FunctionClassDeviceDataBuffer) < BytesReturned then
              SetLength(FunctionClassDeviceDataBuffer,BytesReturned);
            FunctionClassDeviceData := @FunctionClassDeviceDataBuffer[0];
            FunctionClassDeviceData.cbSize := SizeOf(TSPDeviceInterfaceDetailData);
            {$IFDEF WIN64}
               // Sonderaktion für 64 Bit, da stimmt die Größe des Records nicht, ist aber auch egal
               // weil die Daten natürlich extra angelegt sind
               FunctionClassDeviceData.cbSize := 8;
            {$ENDIF}
            success := SetupDiGetDeviceInterfaceDetail(PnPHandle, @DeviceInterfaceData,
              FunctionClassDeviceData, BytesReturned, BytesReturned, @DevData);
            if not success then
              FLastError := GetLastError;
            if success then
            begin
              // gives the friendly name of the device as shown in Device Manager
              lFriendlyName := GetRegistryPropertyString(PnPHandle, DevData, SPDRP_FRIENDLYNAME);
              // gives a device description
              lDeviceDescription := GetRegistryPropertyString(PnPHandle, DevData, SPDRP_DEVICEDESC);
              // now try to get the assigned COM port name
              lPortName := '';
              lSymbolicName := '';
              RegKey := SetupDiOpenDevRegKey(PnPHandle, DevData, DICS_FLAG_GLOBAL, 0, DIREG_DEV, KEY_READ);
              try
                RegType := REG_SZ;
                RegSize := SizeOf(RegBuffer);
                if 0 = RegQueryValueEx(RegKey, 'PortName', nil, @RegType, @RegBuffer[0], @RegSize) then
                begin
                  lPortName := RegBuffer;
                  RegSize := SizeOf(RegBuffer);
                  if 0 = RegQueryValueEx(RegKey, 'SymbolicName', nil, @RegType, @RegBuffer[0], @RegSize) then
                    lSymbolicName := RegBuffer;
                end;
              finally
                RegCloseKey(RegKey);
              end;
              Inst := DevData.DevInst;
              CM_Get_Parent(Inst, Inst, 0);
              lBus := ExtractBus(GetDeviceID(Inst));
              // Informationen der COM-Ports in die Liste eintragen
              if Length(lPortName) > 0 then // Port wurde gefunden
              begin
                ndx := FPortNames.IndexOf(lPortName); // Nachschauen ob der Port schon einmal gefunden wurde
                if ndx < 0 then
                  ndx := FPortNames.Add(lPortName);
                while FFriendlyNames.Count <= ndx do
                  FFriendlyNames.Add('');
                FFriendlyNames[ndx] := lFriendlyName;
                while FDeviceDescriptions.Count <= ndx do
                  FDeviceDescriptions.Add('');
                FDeviceDescriptions[ndx] := lDeviceDescription;
                while FSymbolicNames.Count <= ndx do
                  FSymbolicNames.Add('');
                FSymbolicNames[ndx] := lSymbolicName;
                while FBusses.Count <= ndx do
                  FBusses.Add('');
                FBusses[ndx] := lBus;
              end;
            end;
          end;
        end
        else
        begin
          FLastError := GetLastError;
          if FLastError = ERROR_NO_MORE_ITEMS then
            FLastError := ERROR_SUCCESS;
        end;
        Inc(Devn);
      until not Success;
      // Liste(n) sortieren
      Sort;
    finally
      SetupDiDestroyDeviceInfoList(PnPHandle);
    end;
  end;
end;
procedure TSerialPortListEnhanced.SimpleList(const Items : TStrings; const Flags : TSerialPortListEnhancedSimpleListFlags);
var
  i : Integer;
  s : String;
begin
  Items.BeginUpdate;
  try
    Items.Clear;
    for i := 0 to PortCount-1 do
    begin
      if Flags = [] then
        Items.Add(PortNames[i])
      else
      begin
        s := PortNames[i]+ ' (';
        if slFriendlyNames in Flags then
          s := s + '"'+FriendlyNames[i]+'", ';
        if slDeviceDescriptions in Flags then
          s := s + '"'+DeviceDescriptions[i]+'", ';
        if slSymbolicNames in Flags then
          s := s + '"'+SymbolicNames[i]+'", ';
        if slBusses in Flags then
          s := s + '"'+Busses[i]+'", ';
        if Copy(s,Length(s)-1) = ', ' then
          SetLength(s,Length(s)-2);
        s := s + ')';
        Items.Add(s);
      end;
    end;
  finally
    Items.EndUpdate;
  end;
end;

constructor TSerialPortListEnhanced.Create;
begin
  inherited;
  FPortNames := TStringList.Create;
  FFriendlyNames := TStringList.Create;
  FDeviceDescriptions := TStringList.Create;
  FSymbolicNames := TStringList.Create;
  FBusses := TStringList.Create;
  Update;
end;
destructor TSerialPortListEnhanced.Destroy;
begin
  if Assigned(FPortNames) then
    FreeAndNil(FPortNames);
  if Assigned(FFriendlyNames) then
    FreeAndNil(FFriendlyNames);
  if Assigned(FDeviceDescriptions) then
    FreeAndNil(FDeviceDescriptions);
  if Assigned(FSymbolicNames) then
    FreeAndNil(FSymbolicNames);
  if Assigned(FBusses) then
    FreeAndNil(FBusses);
end;

var
  SetupAPILoaded : Boolean;
  ConfigManagerApiLoaded : Boolean;

function SerialPortAPIsLoaded : Boolean;
begin
  Result := SetupAPILoaded and ConfigManagerApiLoaded;
end;


initialization
  // these API conversions are loaded dynamically by default
  SetupAPILoaded :=LoadSetupApi;
  ConfigManagerApiLoaded := LoadConfigManagerApi;
finalization
  // unload API conversions
  if SetupAPILOaded then
    UnloadSetupApi;
  if ConfigManagerApiLoaded then
    UnloadConfigManagerApi;
end.