COM Ports im System auslesen

[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

[rakekniven]

Zitat von christian.noeding:

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

Hallo Christian,

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

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

Gruß

[Jakson]

Hallo zusammen

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

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

Hier meine Unit

Code:

unit SerialPorts;

interface

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

  function GetComPorts:SerialPort_Ar;

implementation

uses Windows, SysUtils, Classes, Registry;

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

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

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

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

end.

[stoxx]

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

[ekke]

Zitat von stoxx:

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

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

Code:

with TRegistry.Create(KEY_READ) do

gehts.

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

@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