COM Ports im System auslesen

[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.

[stiphen]

Zitat von christian.noeding:

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

[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.

[1967Schorsch]

Hallo zusammen,
ich nutze Delphi 6 seit ein paar Monaten und habe mit etwas Hilfe ein kleines Programm auf die Beine gestellt mit dem ich ein Eprom File zusammen stelle und dieses nun in einen AVR uploaden will. Dazu benutze ich den AVRootloader Ver. 6 von Hagen. Den AVRootloader rufe ich direkt aus meine Programm auf. Mit einer kleine Form suche ich die Parameter entsprechend aus und starte dann den Upload. Wenn nicht alle Parameter in den Eingabefeldern drin sind wird auch der Senden Button nicht freigegeben. Funktioniert soweit auch ganz gut.

Um einen möglichen Fehler abzufangen und aus Komfortgründen möchte ich nun die Auswahl des ComPort des USB-RS232 Wandler etwas vereinfachen.
Dazu habe ich die Prozedur eingebunden.
************************************************** ************
// COM-Ports von 1 bis 16 abklappern
portchange.Clear;
for i:=1 to 16 do
begin
TestHandle := CreateFile(PChar('\\.\COM'+IntToStr(i)),GENERIC_RE AD or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_FLAG_OVERLA PPED,LongInt(0));
if (TestHandle > 0) then
begin
portchange.Items.Add('COM'+inttostr(i));
CloseHandle(TestHandle);
end;
end;
************************************************** ***********
Mit ein paar Anpassungen an meine ComboBox funktioniert das auch mit aufrufen der Form, die ComboBox wird gefüllt und ich kann über die Dropdown Auswahl den ComPort anwählen. Am Notebook ist nur einer angesteckt.... so kommt auch nur einer.

Nun zu meiner Frage: Wie stelle ich es an, dass auch das Abziehen des USB-RS232 Wandler vom System bemerkt wird und die ComboBox geleert wird. ?

Ich habe es schon mit einbinden eines Timer probiert, das funktionier aber nicht wirklich.

Danke für Euere Hilfe und Anregungen.

LG.
Schorsch

[himitsu]

CreateFile bietet nur einen rudimentären Zugriff.
Für den volständigen Zugriff gibt es spezielle APIs.
https://docs.microsoft.com/de-de/win...ions-functions

Im neuen Delphi kannst dir über Get-It eine/mehrere SerialPort-Komponenten runterladen.
Eventuell hat Eine bereits ein entsprechendes Event für neue/getrennte Ports.
Oder halt manuell irgendwo suchen und installieren. Delphi AsyncPro delphi serial port)




Das Erkennen von Ports geht recht einfach, wobei CreateFile mit deiner halben Fehlerbehandlung nur "freie" Ports erkennt.

Das Abziehen des Serial-Controllers, wenn du grade eine Verbindung hast, ist einfach, da du hier eine Fehlermeldung bekommst. (Rückgabewerte deiner API-Aufrufe ala Read/Write/...)
Über die SetupAPI gibt es bestimmt direkte Events/Notifications.
Eventuell kommt auch ein WM_WININICHANGE im System rum, wenn ein Port hinzugefügt/entfernt wird.
Falls ich dran denk, kann ich heut abend mal nachsehn, was passiert, wenn ich einen Arduino an-/absteck.


Bleibt der USB-Serial-Wandler am System, dann ist es erstmal unmöglich überhaupt zu erkennen, ob am Seriel überhaupt was dran hängt,
da du bestimmt standardmäßig ohne Flusskontrolle arbeitest und somit das System es garnicht erkennen kann.
Hartwareflusssteuerung ala RTS/CTS wird vermutlich nicht aktiv sein. (ist es fast nie, da zu oft nur die beiden Datenleitungen verbunden sind, oder sogar nur eine Datenleitung)
Rückkopplung über Softwareprotokoll ist für das System nicht erkennbar, also ob die Software z.B. auf ein ACK-Signal oder X-ON/X-OFF reagiert.

USB-Serial im Board des AVR/Arduino/... (also USB-Port auf dem Board)
oder USB-Serial-Wandler immer komplett vom System abziehen,
nur das kann Windows etwas erkennen und dir mitteilen.

Bleibt der USB-Ports im System, dann kannst du nur pollen,
also regelmäßig dem ARV etwas schicken und auf eine Antwort warten ... kommt nichts zurück, dann ist er weg/aus.





Varianten zum Auflisten:

GetDefaultCommConfig, bzw. die SetupAPI benutzen,
oder QueryDosDevice und alles nehmen, was mit "COM" beginnt
oder siehe HKLM\Hardware\DeviceMap\SerialComm
oder WMI
oder ...

Bei CreateFile für Ports über 10 solltest/musst du den UNC-Pfad benutzen (bei kleiner muß nicht)
und da du nur auf freie Ports zugreifen kannst, die von keinem Programm aktuell im Zugriff sind, mußt du hier die Fehlerbehandluing "richtig" machen.
Also nicht nur das Result, sondern bei Fehler auch GetLastError auf "Zugriff verweigert" ausweten.

https://docs.microsoft.com/en-us/win...stall/setupapi

Da in der mitte findest du einen Beispielcode von Yangghi Min.
Und fast am Ende für QueryDosDevice.
https://social.msdn.microsoft.com/Fo...orum=vcgeneral

https://stackoverflow.com/questions/...ports-in-win32

https://stackoverflow.com/questions/...-devicemanager




Mit Delphi 6 jetzt erst angefangen?
Tipp: https://www.embarcadero.com/de/products/delphi/starter (ist sehr viel größer und wesentlich langsamer, kann aber auch mehr un)

[Rollo62]

Damit hat es mal gut funktioniert, habe ich aber unter Win10 nicht weiter getestet:

Delphi-Quellcode:

procedure TSerialManager.WinProc(Message, wParam, lParam : longint);
type
  TDev_Broadcast_Hdr = packed record
    dbch_size,
    dbch_devicetype,
    dbch_reserved : cardinal;
  end;
  PDev_Broadcast_Hdr = ^TDev_Broadcast_Hdr;
begin

  if Message=WM_DEVICECHANGE then
  begin
    if wParam=DBT_DEVICEARRIVAL then
    begin  // Ein Gerät wurde hinzugefügt
      if PDev_Broadcast_Hdr(lParam).dbch_devicetype=DBT_DEVTYP_PORT then
      begin  
....
      end;
    end
    else
    if wParam=DBT_DEVICEREMOVECOMPLETE then
    begin  // Ein Gerät wurde entfernt
      if PDev_Broadcast_Hdr(lParam).dbch_devicetype=DBT_DEVTYP_PORT then
      begin  
....
      end;
    end;
...
  end;
end;

[1967Schorsch]

Hallo zusammen,
für die Problematik fehlt es mir wohl an Fachwissen.

Das Beispiel von Rollo62 möchte ich gerne ausprobieren.... es schein aber die Komponenten TSerialmanager im Delphi 6 zu fehlen.

Ohne tiefgreifende Hilfe schaffe ich das nicht.

procedure TSerialManager.WinProc(Message, wParam, lParam : longint);
type
TDev_Broadcast_Hdr = packed record
dbch_size,
dbch_devicetype,
dbch_reserved : cardinal;
end;
PDev_Broadcast_Hdr = ^TDev_Broadcast_Hdr;
begin

if Message=WM_DEVICECHANGE then
begin
if wParam=DBT_DEVICEARRIVAL then
begin // Ein Gerät wurde hinzugefügt
if PDev_Broadcast_Hdr(lParam).dbch_devicetype=DBT_DEV TYP_PORT then
begin
....
end;
end
else
if wParam=DBT_DEVICEREMOVECOMPLETE then
begin // Ein Gerät wurde entfernt
if PDev_Broadcast_Hdr(lParam).dbch_devicetype=DBT_DEV TYP_PORT then
begin
....
end;
end;
...
end;
end;