Windows Registry SERIALCOMM falsch angezeigt?

[fseuhs]

Hallo,

Ich arbeite an einem Programm in dem ich die serielle Schnittstelle verwenden möchte. Dabei lese ich mit folgendem Code die Beschreibung und COM# der vorhandenen COMs aus.:

Code: Alles auswählen

 
procedure LoadCOM(portliste: Tstrings; beschreibung: Tstrings; enableloop: boolean);
var
   registry: TRegistry;
   i: integer;
   s, t: Ansistring;
begin
  	portliste.Clear();
  	beschreibung.Clear();
  	registry := TRegistry.Create();
  	registry.RootKey := HKEY_LOCAL_MACHINE;
  	if registry.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM\') then
        begin
        registry.GetValueNames(beschreibung);
  		for i := 0 to beschreibung.Count - 1 do
        begin
            s := beschreibung.Strings[i];
            t := registry.ReadString(s);
  			portliste.Add(t);
        end;
  		registry.CloseKey();
  	end;
  	registry.Free;
 

Das hat bis jetzt recht gut funktioniert, mit COM# in der portliste und dem Converternamen in der beschreibung.

Jetz habe ich mir einen China USB-RS485-Converter gekauft, der verhält sich leider aber etwas eigenartig in Windows (10).
Im Gerätemanager wird

USB-SERIAL CH340 (COM5)

angezeigt.
Im Windows System 'Bluetooth und andere Geräte' scheint er ebenso auf.
In der Registry steht aber

\Device\Serial..... die Punkte stehen für ein paar chinesische Zeichen.

In Lazarus wird dafür

\Device\Serial??????

gefunden und damit kann ich leider nicht die COM# auslesen sonder es wird mir ein Leerstring zurückgegeben.
Ist ads ein Fehler in TRegistry, oder mache ich etwas falsch?

Danke für die Hilfe im voraus.
MFG Fritz

[Mathias]

Ich arbeite an einem Programm in dem ich die serielle Schnittstelle verwenden möchte.

Hast du die mal synaser angeguckt, eine sehr gute Package für den COM-Port ?

USB-SERIAL CH340 (COM5)

Dies ist ein sehr verbreitetet Converter, dieser wird vielfach in den China-Arduinos verbaut. Probleme habe ich keine mit diesen.

Ich habe da noch eine Routine zu auslesen der Com-Ports, die sieht ein wenig anders aus als deine, aber ob es einen Einfluss hat ?

Code: Alles auswählen

function GetSerialPortNames: string;
var
  reg: TRegistry;
  l, v: TStringList;
  n: integer;
begin
  l := TStringList.Create;
  v := TStringList.Create;
  reg := TRegistry.Create;
  try
{$IFNDEF VER100}
{$IFNDEF VER120}
    reg.Access := KEY_READ;
{$ENDIF}
{$ENDIF}
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.OpenKey('\HARDWARE\DEVICEMAP\SERIALCOMM', false);
    reg.GetValueNames(l);
    for n := 0 to l.Count - 1 do
      v.Add(PChar(reg.ReadString(l[n])));
    Result := v.CommaText;
  finally
    reg.Free;
    l.Free;
    v.Free;
  end;
end; 

[wp_xyz]

Wenn Lazarus und Windows bei Strings mit Nicht-ASCII-Zeichen etwas anderes anzeigen, dann sind in der Regel Stringkodierungsprobleme schuld. Windows hat Widestrings oder ANSI-Strings, je nachdem wie man darauf zugreift, Lazarus UTF8-Strings. Du schreibst nicht, welchen Lazarus und v.a. welchen FPC zu verwendest. Wahrscheinlich musst du eine Konvertierungsfunktion aufrufen, etwa UTF16ToUTF8(). Dazu kommt noch, dass die Registry der FCL die Ansi-Stringfunktionen verwendet. Das heißt, dass die chinesischen Zeichen schon beim Einlesen verloren gehen, weil sie nicht auf unserer ANSI-Codeseite sind - da hilft dann auch eine Konvertierungsroutine nichts mehr.

In englischen Forum ist aber die folgende Funktion veröffentlicht worden, die die Registry-Strings als WideStrings (also UTF16) ausliest:

Code: Alles auswählen

uses windows, jwawinreg;
 
function RegistryReadString(const ARootKey: HKEY; AKeyName, AStringValue: WideString): WideString;
var
  lpKey: HKEY;
  lpSize: DWORD;
  lptype: DWORD;
  lpWs: WideString;
begin
  Result := '';
  lpKey := 0;
  if RegOpenKeyExW(ARootKey, PWideChar(AKeyName), 0, KEY_READ, lpKey) = ERROR_SUCCESS then
  begin
    lpType := 0;
    lpSize := 0;
    if RegQueryValueExW(lpKey, PWideChar(AStringValue), nil, @lpType, nil, @lpSize) = ERROR_SUCCESS then
    begin
      if lpType in [REG_SZ, REG_EXPAND_SZ] then
      begin
        SetLength(lpWs, lpSize);
        if RegQueryValueExW(lpKey, PWideChar(AStringValue), nil, @lpType, PByte(lpWs), @lpSize) = ERROR_SUCCESS then
        begin
          SetLength(lpWs, StrLen(PWideChar(lpWs)));
          Result := lpWs;
        end;
      end;
      RegCloseKey(lpKey);
    end;
  end;
end;

Damit kannst du nun das "Registry.ReadString" in deinem Code ersetzen:

Code: Alles auswählen

uses LazUTF8;
procedure LoadCOM(portliste: Tstrings; beschreibung: Tstrings); //; enableloop: boolean);
var
   registry: TRegistry;  
   i: integer;
   s, t: string;
   w: widestring;
begin
     portliste.Clear();
     beschreibung.Clear();
     registry := TRegistry.Create();
     registry.RootKey := HKEY_LOCAL_MACHINE;
     if registry.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM') then
        begin
        registry.GetValueNames(beschreibung);
        for i := 0 to beschreibung.Count - 1 do
        begin
            s := beschreibung.Strings[i];
            // t := registry.ReadString(s);     <-- ersetzen durch folgende zwei Zeilen
            w := RegistryReadString(HKEY_CURRENT_USER, 'HARDWARE\DEVICEMAP\SERIALCOMM', s);
            t := UTF16ToUTF8(w);     // <--- UTF16ToUTF8 kann bei FPC3 entfallen.
            PortListe.Add(t);
        end;
        registry.CloseKey();
     end;
     registry.Free;
end; 

[siro]

Hallo Fritz,
ich habe eben mal deinen Code probiert. (geringfügig, umgestellt)
Ich habe 2 USB to Serial Converter an meinem Laptop mit Windows 8.1
und die Ausgabe sieht dann bei mir so aus:

Listbox_Ausgabe.jpg (5.36 KiB) 2341 mal betrachtet

im Gerätemanager sieht das aber so aus:

Manager_Ausgabe.jpg (12.75 KiB) 2339 mal betrachtet

hab das grad auch noch unter Windows 10 probiert.
Geht bei mir auch.

Die CH340 "chinesischen" Chips scheinen etwas problematisch mit den Treibern zu sein, hier wird auch nicht explizit Win10 angegeben.
Ich hab mir die CP2104 Silabs Umsetzer besorgt, hier bekommt man für alle System die Treiber und das ist ein "vernünftiger" Hersteller für die Chips sowie Treiber
Die Platinchen gibts auch recht preiswert z.B. bei PoLoLu
https://www.pololu.com/product/1308

Wenn die Software nicht läuft muss die Hardware geändert werden....(Spass natürlich )

[siro]

Vielleicht hilft Dir auch noch mein folgender Code, falls Du prüfen willst ob die Schnittstelle existiert oder zur Zeit belegt ist von einem anderem Programm.

Code: Alles auswählen

 
{------------------------------------------------------------------------------}
{ liefert den erforderlichen Windowsnamen zurück }
{ COM1,COM2,COM3...COMx }
{ ab COM10 gibt es eine spezielle Namensgebung }
{ \\.\COM10    \\.\COM11    \\.\COM12   ..... }
{ an das Ende wird immer ein 0x00 angehangen für die C Convertierung }
{ bzw. als Endmarkierung für den "C" String }
{ dieser wird benöigt bei CreatFile, also dem Öffnen der Schnittstelle }
 
function ComXname(no:word):string;
begin
  if no < 10 then result:='COM'+IntToStr(no)+char(0)       { COM 1..9 }
             else result:='\\.\COM'+IntToStr(no)+char(0);  { COM 10..nn }
end;
 
 
{------------------------------------------------------------------------------}
{ Pruefen ob eine Schnittstelle existiert und auch verfügbar ist.              }
{ Es wird versucht die Schnittstelle zu öffen mit CreateFile.                  }
{ Bekommen wir einen gültigen Handle, dann hat es geklappt, damit existiert    }
{ die Schnittstelle also und sie steht uns auch zur Verfügung, ist demnach     }
{ nicht in Benutzung. Bekommen wir einen ungültigen Handle, kann dies mehrere  }
{ Ursachen haben: Die Ursache koennen wir dann mit GetLastError ermiteln.      }
{ Liefert die Funktion GetLastError ERROR_ACCESS_DENIED (0x05) zurueck,        }
{ dann existiert die Schnittstelle zwar, aber wir haben keinen Zugriff.        }
{ Vermutlich ist sie von einem anderem Programm belegt. Terminal oder so...    }
{ Wenn die Schnittstelle garnicht existeirt liefert GetLastError die Kontsante }
{ ERROR_FILE_NOT_FOUND zurueck.                                                }
{                                                                              }
{ Rückgabe:                                                                    }
{ exist = TRUE ==> Schnittstelle existiert, evtl. aber belegt                  }
{ avail = TRUE ==> Schnittstelle ist frei und kann benutzt werden              }
{ Info: avail kann nur TRUE sein wenn exist auch TRUE ist                      }
procedure ComPortCheck(PortNo:Word; var exist:Boolean; var avail:Boolean);
var hFile:THandle; e:DWORD;
begin
  exist:=FALSE; avail:=FALSE; { Waring Error beseitigen }
 
  hFile:=CreateFile(pChar(ComXName(PortNo)),         { lpFileName }
                      GENERIC_READ + GENERIC_WRITE,   { dwDesiredAccess }
                      0,                              { dwShareMode }
                      nil,                            { lpSecurityAttributes }
                      OPEN_EXISTING,                  { dwCreationDistribution }
                      FILE_ATTRIBUTE_NORMAL,          { dwFlagsAndAttributes }
                      0);                             { hTemplateFile }
 
  if hFile = INVALID_HANDLE_VALUE then begin   { ungülitger Handle, prüfen }
    e:=GetLastError;                           { mittels GetLastError }
    if e = ERROR_ACCESS_DENIED  then begin
      exist:=TRUE;  { Schnittstelle existiert zwar }
      avail:=FALSE; { wird schon benutzt (schon geöffnet) }
    end;
    if e = ERROR_FILE_NOT_FOUND then begin
      exist:=FALSE;   { schnittstele existiert nicht }
      avail:=FALSE;   { ist also auch nicht verfügbar }
    end;
  end else begin    { Schnittstelle existiert und kann verwendet werden }
    exist:=TRUE;
    avail:=TRUE;
    CloseHandle(hFile);  { Schnittstelle wieder schliessen }
  end; { else }
end; { for no }
 
{------------------------------------------------------------------------------}
{ liefert TRUE wenn die übergebene PortNo existiert und verfügbar ist }
{ liefert FALSE wenn Schnittstelle nicht existiert oder belegt ist }
Function ComAvail(PortNo:Word):Boolean;
var exist,avail:Boolean;
begin
  exist:=FALSE; avail:=FALSE; { Warning Error beseitigen }
 
  ComPortCheck(PortNo,exist,avail);
  result:=avail;
end;

Wie man an die Namen, wie sie im Gerätemanager angezeigt werden, rankommt würde mich aber auch sehr interessieren.
Da hab ich auch noch nix....

[fseuhs]

Danke für die Antworten.

@ siro

Das funktioniert wahrscheinlich, ist aber aus 2 Gründen für mich nicht das was ich suche:
1. Man bekommt nur die COM# aber nicht den Beschreibungsstring dazu.
2. Wie viele # muß ich iterieren (10, 100, 1000) um wirklich alle angeschlossenen COMs zu erhalten.

@ Mathias

Habe es ausprobiert, leider geht das auch nicht.

@ wp_xyz

Habe ich auch ausprobiert, geht überhaupt nicht, auch die "normalen" USB Converter werden nicht gefunden. Habe nicht weiter gesucht, da Du den code aus anderen Quellen hast.

Ich habe vor ein paar Jahren praktisch die gleiche Methode in C++ (Embacadero C++Builder 2009) verwendet und es funktionirt auch heute noch am neuesten PC.
Zwar mit dem chinesischem Beschreibungsstring, aber COM# wird gefunden und die Schnittstelle funktioniert auch!
Folgend ein paar Screenshots:

CPP - Programm.png (5.11 KiB) 2317 mal betrachtet

Dazu die Funktion:

Code: Alles auswählen

void RS232::LoadCOM(TStrings* portliste, TStrings* beschreibung)
{
	if (SWLoopback) {
		return;
	}
	TRegistry* registry = new TRegistry;
	registry->RootKey = HKEY_LOCAL_MACHINE;
	if (registry->OpenKeyReadOnly("\\HARDWARE\\DEVICEMAP\\SERIALCOMM\\")) {
		portliste->Clear();
		beschreibung->Clear();
		registry->GetValueNames(beschreibung);
		for(int i=0; i< beschreibung->Count; i++) {
			portliste->Add(registry->ReadString(beschreibung->Strings[i]));
        }
		registry->CloseKey();
	}
	delete registry;
} 

Das sollte doch auch mit Lazarus funktionieren?!

Jetzt noch Screenshots zum System

Gerätemanager.png (6.49 KiB) 2317 mal betrachtet

Regedit:

[wp_xyz]

@ wp_xyz
Habe ich auch ausprobiert, geht überhaupt nicht, auch die "normalen" USB Converter werden nicht gefunden. Habe nicht weiter gesucht, da Du den code aus anderen Quellen hast.

Warum gibst du so schnell auf? Erwartest du eine fertige Lösung?

Ich sehe gerade an deinem Screenshot, dass die chinesischen Zeichen ja im Schlüsselnamen des Registry-Wertes stecken - ich dachte immer, da müssten ASCII-Zeichen sein - ist anscheinend nicht der Fall. Aber das heißt dann, dass schon die Funktion Registry.GetValueNames die chinesichen Zeichen nicht erkannt hat, so dass du mit einem falschen Schlüssel in die Abfrage des Wertes gehst. Du musst also suchen, mit welcher Widestring-Registry-Funktion du die Schlüsselnamen abfragen kannst (also das, was Registry.GetValueNames macht auf Widestring übertragen). Dann muss es gehen.

[EDIT]
Im Juli wurden im FPC die A-Aufrufe der Registry ("Ansi") durch die "W"-Funktionen ersetzt ("Widestring") (https://bugs.freepascal.org/view.php?id=32185). Daher sollte dein ursprünglicher Code mit FPC-trunk ohne Änderung funktionieren.

[fseuhs]

Also in C++ funktioniert das mit den Chinazeichen wie du aus dem Screenshot ersehen kannst. Die Chinazeichen werden offensichtlich so weitergegeben und ich bekomme die richtige COM# zurück.

Ich erwarte mir nicht eine fertige Lösung, sondern nur Tipps.

Ich habe inzwischen eine andere Tregistry im englischem Lazerusforum heruntergeladen (TReistry_UTF8), die das Problem beheben sollte. Da komme ich etwas weiter.
Im Debugger angesehen ergibt die Registry.GetValueNames die richtigen Zeichen (inklusive Chinazeichen). Erst die nächste Funktion registry.ReadString(s) scheitert.
Bin mit Lazarus noch nicht so vertraut, daher die Frage was ist "FPC-trunk"?
Ich habe Lazarus erst vor ca. 1 Monat installiert, sollte doch ziemlich neu sein.

[wp_xyz]

fpc-trunk ist die Entwickler-Version von fpc (Free-Pascal-Compiler). Unter Windows geht die Installation am einfachsten mit fpcupdeluxe (https://github.com/newpascal/fpcupdelux ... ag/v1.6.0h, http://wiki.freepascal.org/fpcupdeluxe).

Da ich in meinem System keinen Registry-Eintrag finde, der Nicht-ASCII-Zeichen auf der Key-Seite (links) eines Registryeintrag hat, kann ich leider nicht testen, ob sich die Mühe der FPC-Trunk-Installation lohnt. Mein Beitrag oben war mit einem Eintrag getestet, der die Nicht-ASCII-Zeichen auf der Wert-Seite (rechts) hatte, deshalb hat der Code bei dir nicht funktioniert.