AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

COM Ports im System auslesen

Ein Thema von Moony · begonnen am 11. Aug 2008 · letzter Beitrag vom 10. Feb 2019
Antwort Antwort
Seite 3 von 3     123
Jakson

Registriert seit: 10. Mär 2006
33 Beiträge
 
#21

AW: COM Ports im System auslesen

  Alt 21. Okt 2013, 13:49
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.

Geändert von Jakson (21. Okt 2013 um 15:32 Uhr) Grund: Description eingefügt
  Mit Zitat antworten Zitat
Benutzerbild von stoxx
stoxx

Registriert seit: 13. Aug 2003
1.111 Beiträge
 
#22

AW: COM Ports im System auslesen

  Alt 7. Jan 2014, 20:35
die Funktion funktionierte nicht mehr unter Win8 .. die SetupAPI ist da besser gestellt ...
und Dein Sortieralgorithmus hat definitiv eine Macke.
Phantasie ist etwas, was sich manche Leute gar nicht vorstellen können.

Geändert von stoxx ( 7. Jan 2014 um 21:22 Uhr)
  Mit Zitat antworten Zitat
stiphen

Registriert seit: 18. Nov 2014
1 Beiträge
 
#23

AW: Re: COM Ports im System auslesen

  Alt 18. Nov 2014, 07:00
Hi,


habe auch lange nach einer sauberen Methode gesucht. Diese hier erkennt alle COM-Ports und zeigt auch die Beschreibung an. Die COM-Ports werden bei meiner Funktion in die Combobox "portchange" eingefügt. Es wird die SetupAPI der Jedis benötigt:

Delphi-Quellcode:
procedure SearchSerialPorts;
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;
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;

  // Combobox klarmachen
  portchange.Items.BeginUpdate;
  portchange.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));
            
          // COM-Ports in Combobox eintragen
          portchange.Items.Add(PortName + ' (' + DeviceDescription + ', ' + Bus+')');
        end;
        FreeMem(FunctionClassDeviceData);
      end;
    end;
    Inc(Devn);
  until not Success;
  SetupDiDestroyDeviceInfoList(PnPHandle);

  // Combobox freigeben
  portchange.Items.EndUpdate;

  // unload API conversions
  UnloadSetupApi;
  UnloadConfigManagerApi;
end;

Das führt dann zu dem Ergebnis im Anhang.




eine alternative Suchmethode, die allerdings keine Beschreibung des COM-Ports anzeigt:

Delphi-Quellcode:
// COM-Ports von 1 bis 16 abklappern
  portchange.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
      portchange.Items.Add('COM'+inttostr(i));
      CloseHandle(TestHandle);
    end;
  end;

Viel Erfolg,
Christian
while using sample Attchment why I get error File not found 'Cfg.dcu' and File not found 'CfgMgr32.dcu'
I am using D7 .. Win7 32 Bit
  Mit Zitat antworten Zitat
ekke

Registriert seit: 14. Nov 2009
18 Beiträge
 
#24

AW: COM Ports im System auslesen

  Alt 9. Feb 2019, 17:47
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.
  Mit Zitat antworten Zitat
zeras

Registriert seit: 11. Mär 2007
Ort: Langeneichstädt
1.071 Beiträge
 
Delphi 10.3 Rio
 
#25

AW: COM Ports im System auslesen

  Alt 10. Feb 2019, 16:59
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.
Matthias
Es ist nie falsch das Richtige zu tun!
- Mark Twain
  Mit Zitat antworten Zitat
ekke

Registriert seit: 14. Nov 2009
18 Beiträge
 
#26

AW: COM Ports im System auslesen

  Alt 10. Feb 2019, 19:06
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 (edo@domis.de)
// 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.
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:42 Uhr.
Powered by vBulletin® Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2019 by Daniel R. Wolf