COM Ports im System auslesen

[Moony]

Hallo zusammen,

ich möchte alle im System angemeldeten, seriellen Ports auslesen. Egal ob on Board, via PCI Karte oder USB-To-Serial.

Hoffe mir kann jemand helfen.

Danke & Gruß, Moony

[Reinhard Kern]

Zitat:

Zitat von Moony

Hallo zusammen,

ich möchte alle im System angemeldeten, seriellen Ports auslesen. Egal ob on Board, via PCI Karte oder USB-To-Serial.

Hoffe mir kann jemand helfen.

Danke & Gruß, Moony

Hallo,

am einfachsten von COM1 bis COMx (256 sollte reichen) iterieren, dann ist man nicht von speziellen Registry-Inhalten abhängig. Öffnen lassen sich natürlich nur Schnittstellen, die vorhanden sind und nicht von einem anderen Programm verwendet werden. Bei den "besetzten" lässt sich nur die Existenz anzeigen.

Gruss Reinhard

[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 ;-)

[Moony]

Danke für die fixe Antwort. Ich werde beide Routinen mal ausprobieren und dann bescheid geben.

Gruß, Moony


Aso, wo finde ich die SetupAPI ???

[christian.noeding]

Da nimmste einfach den ersten Google-Eintrag bei der Suche "Jedi Setup API" :)


Jedi SetupAPI bei Sourceforge.NET


Deeplink zur Version 3.15



ciao,
Christian



PS: es müssen in deine Applikation dann folgende Dateien eingebunden werden:

Delphi-Quellcode:

uses
  JwaWinType,
  SetupApi, Cfg, CfgMgr32;

[Moony]

Also, die Alternativeroutine macht es falsch. Ich habe nur einen seriellen Port und dennoch fügt sie mir weitere Ports hinzu.

Die JEdi Geschichte bekomme ich irgendwie nicht angebunden. Habe es mir runtergeladen, das in mein Lib verzeichnis kopiert und in den Umgebungsoptionen das Verzeichnis für die jedis angegeben. Aber delphi erkennt diesen immer noch nicht...

[christian.noeding]

Die "alternative" Methode öffnet jeden seriellen Comport von 1 bis 16 und prüft, ob man auf den Port schreiben kann. Wenn du jetzt natürlich irgendwelche Bluetoothgeräte oder andere Treiber für virtuelle Comports hast, werden die natürlich auch aufgelistet.


Bei der SetupAPI muss das Verzeichnis "..\jedi-api-lib\jwapi\trunk\SaCMAPI" (SetupAPI-Dateien) und das Verzeichnis "..\jedi-api-lib\jwapi\trunk\Win32API" (Win32-API-Dateien) mit in den Suchpfad rein, sonst geht es natürlich nicht.

[Moony]

Hab die beiden Verzeichnisse jetzt im Suchpfad des Projekts eingebunden. In der Uses sind alle Unit angegeben, die du mir gesagt hast. Beim Kompilieren kommt die Fehlermeldung, dass folgende Datei nicht gefunden wurde: jediapilib.inc

[christian.noeding]

Sorry, war unterwegs...


dann musst du halt noch das Verzeichnis "..\jedi-api-lib\jwapi\trunk\Common" mit in den Uses-PFad einbinden. Dort ist nämlich diese inc-Datei drin.


ciao,
Chris

[Chemiker]

Hallo Moony,

willst Du nur die Informationen welche COM-Ports im Rechner vorhanden sind, oder willst Du auch Daten senden/empfangen?

Bis bald Chemiker

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

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

Zitat von christian.noeding (Beitrag 811647)

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:

Zitat von stoxx (Beitrag 1242612)

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. :thumb:

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;

[TurboMagic]

Hallo,

eine solche Komponente brauchst du dafür gar nicht.
Platziere eine TApplicationEvents Komponente (gibt's hoffentlich in D6 schon)
auf deiner Form und schaue dir mal die Events dieser an. Die sollte ein vergleichbares
bieten wie Rollo62 es benutzt hat.

Dort dann mal den Inhalt seiner WinProc Methode einfügen.

Grüße
TurboMagic

[Rollo62]

Das ist eine eigene Klasse, in der ich das gekapselt habe.
Ich hatte ja geschrieben das dort auch noch mehr drumrum zur Absicherung ist.

[himitsu]

Vermutlich musst du vorher dein Programm noch registieren, damit was ankommt.
https://docs.microsoft.com/en-us/win...enotificationa


und deine Codes bitte in [DELPHI]...[/DELPHI] oder [CODE]...[/CODE]

[1967Schorsch]

Ich habs dann irgendwie geschafft ein ApplicationEvents per Komponente einzufügen (Anfängerglück :shock:).
In den Events sehe ich jetzt nicht was so ähnlich heißt wie seine TSerialManager.WinProc Prozedur.:cry:

:?:

[himitsu]

Application.OnMessage (Unit Forms) oder besser TApplicationEvents.OnMessage, weil es das mehrfach geben kann und man sich nicht selbst überschreibt.

Dort kommt alles vorbei, was via PostMessage und PostThreadMessage im Hauptthread des Programms eintrudelt,
und durch Application.Run bzw. Application.ProcessMessages/HandleMessage durchrauscht. (die Hauptbearbeitungsstellen der MessageQueue für unsere VCL)

Probleme gibt es nur, wenn jemand/etwas PeekMessage/GetMessage manuell aufruft und es nicht über Application.ProcessMessages oder .HandleMessage behandeln lässt, welche das OnMessage aufrufen.
z.B. in einigen Implementationen von Delay, als Nichthängenbleibender Ersatz des Sleep oder während ein Windows-Dialog ala MessageBox angezeigt wird.

Diese Messages dürften via PostMessage als Broadcast im System verteilt werden
und standardmäßig nur an TopLevel-Fenster, wie z.B. die Hauptform oder das unsichtbare ControlWindow in Forms.Application.

Wie gesagt, SendMessage kommt in dem Event blöder Weise nicht vorbei, dafür müsste man sich einen GetMessage-Hook basteln, falls es so ankommt.
https://docs.microsoft.com/en-us/win...sg/about-hooks


Es kann aber sein, dass diese Message hier nur an jene Fenster gesendet wird, welche sich vorher registriert haben.
https://docs.microsoft.com/en-us/win...enotificationa

Das Problem mit den an falscher Stelle behandelten/abgefangenen Messages, genauso wie für das übersehene SendMessage,
kann man sich da nun das WndProc seiner Form überschreiben oder die Message direkt anhängen,

Delphi-Quellcode:

procedure WndProc(var Message: TMessage); override;
bzw.
procedure WMDeviceChangeOderSo(var Message: TMessage); message WM_DEVICECHANGE;  // hier geht statt TMessage auch ein passender Typ, siehe TWMSize in Forms.pas

oder man empfängt sowas in einem eigenen Thread mit einer unabhängigen "unsichtbaren" MessageOnly-Form (ähnlich der in Application).

[1967Schorsch]

Hallo,
ich denke ich habe verstanden was du mir sagen willst.

Schade das es mit der Version (Delphi 6, ApplicationEvents Komponente) wohl nicht geht oder nicht so einfach ist.

Sich eine GetMessage-Hook basteln hört sich interessant an, nur wenn man (ich) nicht weis was man da tut, ist es schier unmöglich.
Schade und das nur um mitzubekommen ob der ausgewählte COM Anschluss/ USB Adapter abgesteckt wurde. Die Kommunikation über den Port erledigt ein anderes Programm was erst danach aufgerufen wird.

DANKE !!!:thumb:

[1967Schorsch]

Ich habe nochmal geschaut ..... mit meiner Software steuere ich per ShellExecute die AVRootloader Software an.
Nach Rescherge wurde diese durch Hagen in Delphi 5 geschrieben. Die Behandlung der COM Schnittstelle funkrioniert wie ich das auch hinbekommen möchte. Dann hat er sich sicher auch ein GetMessage-Hook gebastelt.

Hier Version 6 der AVRootloader Software aus dem Microcontroller Forum
https://www.mikrocontroller.net/topi...195903#1195903

[HolgerX]

Hmm..

Zitat:

Zitat von 1967Schorsch (Beitrag 1459482)

Schade das es mit der Version (Delphi 6, ApplicationEvents Komponente) wohl nicht geht oder nicht so einfach ist.

Sich eine GetMessage-Hook basteln hört sich interessant an, nur wenn man (ich) nicht weis was man da tut, ist es schier unmöglich.
Schade und das nur um mitzubekommen ob der ausgewählte COM Anschluss/ USB Adapter abgesteckt wurde. Die Kommunikation über den Port erledigt ein anderes Programm was erst danach aufgerufen wird.

Anbei mal ein einfaches Testtool..
Dieses Reagiert, wenn ich ein USB/COM Adapter einstecke, bzw. Abziehe und gibt mir den entsprechenden Port (COM3..).

Das WM_DEVICECHANGE für DBT_DEVTYP_PORT wird übrigens ohne Registrierung an jedes TopLevel (Hauptfenster) einer Applikation geschickt.

Wie Du siehst nur wenig Source-Code.

Erstellt mit D6 und getestet auf Windows 7.

[1967Schorsch]

Hallo Holger,
super klasse...... genau das habe ich gesucht.

Vielen Dank für die Hilfe:-D