Jump to content
kvk1989

Comport issue

By kvk1989, in General Help

Recommended Posts

kvk1989    2

kvk1989
Posted

I have write debuglog function and when I click button then button message show port not found

But debug log show port found I attached a video for better understand 

Share this post

Link to post

Remy Lebeau    1264

Remy Lebeau
Posted

Why does your device manager keep refreshing and showing the port disappearing? Are you perhaps opening the port during the time it has disappeared? What does your code look like that is opening the port?

Share this post

Link to post

kvk1989    2

kvk1989
Posted
23 minutes ago, Remy Lebeau said:

Why does your device manager keep refreshing and showing the port disappearing? Are you perhaps opening the port during the time it has disappeared? What does your code look like that is opening the port?

Let me show you codes 

 

  

unit HW.FindDevice;

interface

// readonly string string_0 = "{4D36E96D-E325-11CE-BFC1-08002BE10318 } ";
// readonly string string_1 = "F72FE0D4-CBCB-407d-8814-9ED673D0DD6B ";
// readonly string string_2 = "F72FE0D4-CBCB-407d-8814-9ED673D0DD6B ";
// readonly string string_3 = "{146bf252-9f25-4209-a6dd-c45a1180abc4}";

uses
  Winapi.Windows, Winapi.Messages, STRUTILS, forms,
  System.SysUtils, System.Win.Registry, System.Variants, System.Classes, SetupApi2, SetupAPI, inifiles;

Type
  TSetofChars = Set of Char;

  TWUDFDiagnosticInfo = record
    HostPid: dword;
    IoctlTransferMode: dword;
    RetrievalMode: dword;
    RwTransferMode: dword;
  end;

  TDeviceParameters = record
    EnumerationRetryCount: dword;
    PollingPeriod: dword;
    PortName: ansistring;
    SymbolicName: string;
    WUDFDiagnosticInfo: TWUDFDiagnosticInfo;
  end;

  TUSBDeviceInfo = record
    VIDPID: string;
    Address: dword;
    Capabilities: dword;
    ClassGUID: ansistring;
    ContainerID: ansistring;
    device: string;
    DeviceDesc: ansistring;
    DriverGUID: ansistring;
    Driver: ansistring;
    FriendlyName: ansistring;
    HardwareID: Tstringlist;
    LocationInformation: ansistring;
    Mfg: ansistring;
    Service: ansistring;
    UpperFilters: string;
    DeviceParameters: TDeviceParameters;
  end;

  TUSBDeviceList = array of TUSBDeviceInfo;

Function FindDevice(filterVid: string = ''): string;
Function getUSBDeviceInfo(SymbolicName: string): TUSBDeviceInfo;

Function FindDeviceList(var paths: Tstringlist; SEARCH_GUID_STR: string = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}'): integer;
Procedure FindAvailableCOM(list: Tstrings);
Function WaitDeviceDisconnected(symbolic: string; timeout: integer = 3000): boolean;

Function FindPorts(Filter: string = ''): TUSBDeviceList;
Function ExtractVIDPID(symbolic: string): string;
Function getPortFirst(frindlyname: string; timeout: integer = 1000): String;

implementation

uses   main;

function findFriendlyName(key: string; Port: string): string;
var
  r: TRegistry;
  k: Tstringlist;
  i: integer;
  ck: string;
  rs: string;
begin
  r := TRegistry.Create(KEY_READ);
  k := Tstringlist.Create;
  r.RootKey := HKEY_LOCAL_MACHINE;
  r.OpenKeyReadOnly(key);
  r.GetKeyNames(k);
  r.CloseKey;
  try
    for i := 0 to k.Count - 1 do
    begin
      ck := key + k[i] + '\';
      // addlog(ck);
      if r.OpenKeyReadOnly(ck + 'Device Parameters') then
      begin
        if r.ReadString('PortName') = Port then
        begin
          r.CloseKey;
          r.OpenKeyReadOnly(ck);
          rs := r.ReadString('FriendlyName');
          break;
        end
      end
      else
      begin
        if r.OpenKeyReadOnly(ck) and r.HasSubKeys then
        begin
          rs := findFriendlyName(ck, Port);
          if rs <> '' then
            break;
        end;
      end;
    end;
    result := rs;
  finally
    r.Free;
    k.Free;
  end;
end;

Procedure FindAvailableCOM(list: Tstrings);
var
  GUID_CAM: TGUID;
  hDevInfo: Pointer;
  DeviceInfoData: SP_DEVINFO_DATA;
  successful: BOOL;
  i: dword;
  dwSize, dwPropertyRegDataType: dword;
  szDesc: array [0 .. 1023] of Char;
begin
  list.Clear;
  GUID_CAM := StringToGUID('{4D36E978-E325-11CE-BFC1-08002BE10318}');
  // GUID_CAM := StringToGUID('{4D36E96D-E325-11CE-BFC1-08002BE10318}');
  // 4D36E96D-E325-11CE-BFC1-08002BE10318
  // 4D36E978-E325-11CE-BFC1-08002BE10318
  hDevInfo := SetupDiGetClassDevsW(@GUID_CAM, nil, 0, DIGCF_PRESENT);
  if dword(hDevInfo) <> INVALID_HANDLE_VALUE then
  begin
    i := 0;
    repeat
      DeviceInfoData.cbSize := SizeOf(TSP_DevInfo_Data);
      successful := SetupDiEnumDeviceInfo(hDevInfo, i, DeviceInfoData);
      if successful then
      begin
        if (SetupDiGetDeviceRegistryPropertyW(hDevInfo, @DeviceInfoData, SPDRP_FRIENDLYNAME, @dwPropertyRegDataType, @szDesc, SizeOf(szDesc), @dwSize))
        then
        begin
          list.Add(WideCharToString(@szDesc));
          // result := result + WideCharToString(@szDesc) + ';';
        end;
      end;
      Inc(i);
    until not successful;
  end;
end;

// this function based on both:
// http://www.delphikingdom.com/asp/answer.asp?IDAnswer=77001
// https://stackoverflow.com/questions/13927475/windows-how-to-enumerate-all-connected-usb-devices-device-path/13928035#13928035
// so we need modify this function and be creative
{ Result:= CreateFile( functionClassDeviceData^.DevicePath,
  GENERIC_WRITE or GENERIC_READ,
  0, //FILE_SHARE_WRITE or FILE_SHARE_READ,
  Nil,
  OPEN_EXISTING,
  FILE_FLAG_OVERLAPPED,
  0);
}
// Also this one
// https://stackoverflow.com/questions/10154878/delphi-hid-in-delphi7-and-delphi-xe2
// is a good explanation how we can get info on devices
function getGUIDevHandle(s: string; paths: Tstringlist): dword;
var
  GD: TGUID;
  devInfoData: SP_DEVINFO_DATA;
  devInterfaceData: SP_DEVICE_INTERFACE_DATA;
  functionClassDeviceData: PSPInterfaceDeviceDetailData;
  requiredLength: dword;
  deviceNumber: integer;
  hwDeviceInfo: hDevInfo;
  predictedLength: cardinal;
  ok: boolean;
  path: string;
begin
  result := 0;
  requiredLength := 0;
  GD := TGUID.Create(s);
  hwDeviceInfo := SetupDiGetClassDevs(@GD, Nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE);

  if (cardinal(hwDeviceInfo) <> INVALID_HANDLE_VALUE) then
  begin
    deviceNumber := 0;
    devInterfaceData.cbSize := SizeOf(devInterfaceData);
    while (SetupDiEnumDeviceInterfaces(hwDeviceInfo, Nil, GD, deviceNumber, devInterfaceData)) do
    begin
      // SetupDiGetInterfaceDeviceDetail
      SetupDiGetDeviceInterfaceDetail(hwDeviceInfo, @devInterfaceData, Nil, 0, requiredLength, Nil);
      predictedLength := requiredLength;
      functionClassDeviceData := PSPInterfaceDeviceDetailData(GlobalAlloc(GPTR, predictedLength));
      functionClassDeviceData^.cbSize := SizeOf(TSPDeviceInterfaceDetailData); // ???? - âńĺ îę
      devInfoData.cbSize := SizeOf(devInfoData);
      if (SetupDiGetDeviceInterfaceDetail(hwDeviceInfo, @devInterfaceData, functionClassDeviceData, predictedLength, requiredLength, @devInfoData))
      then
      begin
        path := PAnsiChar(@(functionClassDeviceData^.DevicePath));
        // dlog(path);
        paths.Add(path);
      end;

      GlobalFree(cardinal(functionClassDeviceData));
      Inc(deviceNumber);
    end; // if (SetupDiEnumDeviceInterfaces ( hwDeviceInfo, Nil, GD, deviceNumber, devInterfaceData))

    SetupDiDestroyDeviceInfoList(hwDeviceInfo);
  end; // if hwDeviceInfo <> INVALID_HANDLE_VALUE
  if result = INVALID_HANDLE_VALUE then
    result := 0;
end;

Function FindDevice(filterVid: string = ''): string;
const
  SEARCH_GUID_STR = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
var
  i: integer;
  paths: Tstringlist;
begin
  result := '';
  paths := Tstringlist.Create;
  getGUIDevHandle(SEARCH_GUID_STR, paths);
  for i := 0 to paths.Count - 1 do
  begin
    if lowercase(paths[i]).Contains(lowercase(filterVid)) then // 'vid_05c6'
    begin
      result := paths[i];
      break;
    end;
  end;
  paths.Free;
end;

Function FindDeviceList(var paths: Tstringlist; SEARCH_GUID_STR: string = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}'): integer;
// const
// SEARCH_GUID_STR = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
begin
  result := 0;
  getGUIDevHandle(SEARCH_GUID_STR, paths);
  result := paths.Count;
end;

Function WaitDeviceDisconnected(symbolic: string; timeout: integer = 3000): boolean;
var
  sub: Tstringlist;
  i: integer;
  symbolic_: string;
  Stillfound: boolean;
  loopcount: integer;
begin
  result := false;
 /// log.debug(symbolic);
  sub := Tstringlist.Create;
  try
    Stillfound := true;
    loopcount := 0;
    repeat
      Inc(loopcount);
     // log.ProgGauge(loopcount, timeout);
      sub.Clear;
      FindDeviceList(sub);
      application.ProcessMessages;
      if sub.Count > 0 then
      begin
        Stillfound := false;
        for i := 0 to sub.Count - 1 do
        begin
          application.ProcessMessages;
          symbolic_ := lowercase(sub[i]);
          if lowercase(symbolic_) = lowercase(symbolic) then
            Stillfound := true;

        end;
        if Stillfound = false then
          break;
      end;
      sleep(1);
    until (loopcount >= timeout) or (Stillfound = false);
  finally
    sub.Free;
  end;

  if Stillfound then
   // log.debug('Stillfound')
  else
  //  log.debug('not found');
end;

Function getDriverDetails(DeviceDesc: ansistring): string;
var
  ini: Tinifile;
  windir: string;
  sub: Tstringlist;
  i: integer;
  inf: string;

  PWindowsDir: array [0 .. 255] of Char;
begin
  // get windows folder
  GetWindowsDirectory(PWindowsDir, 255);
  sub := Tstringlist.Create;
  // sub.Delimiter := '%';
  // sub.Text := DeviceDesc;
  sub.DelimitedText := DeviceDesc;
  inf := Copy(trim(sub[0]), 2);
  windir := trim(PWindowsDir) + '\INF\' + inf;
  // addlog(windir);
  if fileexists(windir) then
  begin
    ini := Tinifile.Create(windir);
    result := ini.ReadString('Version', 'DriverVer', '');
    ini.Free;
  end;

end;

Function getUSBDeviceInfo(SymbolicName: string): TUSBDeviceInfo;
var
  sub: Tstringlist;
  DeviceNamesArray: TUSBDeviceList;
  i, c, idx, max: integer;
  reg: TRegistry;
  Tmp: string;
  VIDPID: string;

begin
  if trim(SymbolicName) = '' then
    exit;
  sub := Tstringlist.Create;
  try
    sub.Delimiter := '#';
    sub.DelimitedText := lowercase(SymbolicName);
    {
      \\?\usb
      vid_05c6&pid_9008
      7&10efe18c&0&1
      {a5dcbf10-6530-11d2-901f-00c04fb951ed }
    // }

    if sub.Count > 2 then
    begin
      reg := TRegistry.Create;
      try
        reg.RootKey := HKEY_LOCAL_MACHINE;
        if reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Enum\USB\' + sub[1]) then
        begin
          if (reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Enum\USB\' + sub[1] + '\' + sub[2])) then
          begin
            result.DeviceParameters.SymbolicName := '';
            result.device := sub[2];
            result.LocationInformation := reg.ReadString('LocationInformation'); // Az eszköz leírása
            result.DeviceDesc := reg.ReadString('DeviceDesc'); // Az eszköz leírása
            result.ClassGUID := reg.ReadString('ClassGUID'); // Az eszköz leírása
            result.ContainerID := reg.ReadString('ContainerID'); // Az eszköz leírása
            result.FriendlyName := reg.ReadString('FriendlyName'); // Az eszköz leírása
            result.Service := reg.ReadString('Service'); // Az eszköz leírása
            result.Driver := getDriverDetails(result.DeviceDesc);
            result.DriverGUID := reg.ReadString('Driver');
            result.Mfg := reg.ReadString('Mfg');
            if (reg.OpenKeyReadOnly('Device Parameters')) then
            begin
              result.DeviceParameters.PortName := reg.ReadString('PortName');
              if reg.ValueExists('SymbolicName') then
              begin
                result.DeviceParameters.SymbolicName := reg.ReadString('SymbolicName');
              end;
            end;

          end;
        end;
      finally
        reg.Free;
      end;
    end;
  finally
    sub.Free;
  end;

end;

procedure ReadREG_MULTI_SZ(const CurrentKey: HKey; const Subkey, ValueName: string; Strings: Tstrings);
var
  valueType: dword;
  valueLen: dword;
  p, buffer: PChar;
  key: HKey;
begin
  // Clear TStrings
  // TStrings leeren
  Strings.Clear;
  // open the specified key
  // CurrentKey Schlüssel öffnen
  if RegOpenKeyEx(CurrentKey, PChar(Subkey), 0, KEY_READ, key) = ERROR_SUCCESS then
  begin
    // retrieve the type and data for a specified value name
    // Den Typ und Wert des Eintrags Ermitteln.
    SetLastError(RegQueryValueEx(key, PChar(ValueName), nil, @valueType, nil, @valueLen));
    if GetLastError = ERROR_SUCCESS then
      if valueType = REG_MULTI_SZ then
      begin
        GetMem(buffer, valueLen);
        try
          // receive the value's data (in an array).
          // Ein Array von Null-terminierten Strings
          // wird zurückgegeben
          RegQueryValueEx(key, PChar(ValueName), nil, nil, PBYTE(buffer), @valueLen);
          // Add values to stringlist
          // Werte in String Liste einfügen
          p := buffer;
          while p^ <> #0 do
          begin
            Strings.Add(p);
            Inc(p, lstrlen(p) + 1)
          end
        finally
          FreeMem(buffer)
        end
      end
      else
        raise ERegistryException.Create('Stringlist expected/ String Liste erwartet...')
    else
      raise ERegistryException.Create('Cannot Read MULTI_SZ Value/' + 'Kann den MULTI_SZ Wert nicht lesen...');
  end;
end;

function getUSBDeviceInfoByFriendlyname(key: string; FriendlyName: string): TUSBDeviceInfo;
var
  reg: TRegistry;
  k: Tstringlist;
  i: integer;
  ck: string;
  rs: string;

  fn: string;
  hwidcount: integer;
begin
  reg := TRegistry.Create(KEY_READ);
  k := Tstringlist.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  // key := '\System\CurrentControlSet\Enum\USB\';
  reg.OpenKeyReadOnly(key);
  reg.GetKeyNames(k);
  reg.CloseKey;
  try
    for i := 0 to k.Count - 1 do
    begin
      ck := key + k[i] + '\';
      if reg.OpenKeyReadOnly(ck) then
      begin
        if reg.ReadString('FriendlyName') = FriendlyName then
        begin
          result.DeviceParameters.SymbolicName := '';
          result.device := k[i];
          result.LocationInformation := reg.ReadString('LocationInformation'); // Az eszköz leírása
          result.DeviceDesc := reg.ReadString('DeviceDesc'); // Az eszköz leírása
          result.ClassGUID := reg.ReadString('ClassGUID'); // Az eszköz leírása
          result.ContainerID := reg.ReadString('ContainerID'); // Az eszköz leírása
          result.FriendlyName := reg.ReadString('FriendlyName'); // Az eszköz leírása
          result.Service := reg.ReadString('Service'); // Az eszköz leírása
          result.Driver := getDriverDetails(result.DeviceDesc);
          result.DriverGUID := reg.ReadString('Driver');
          result.Mfg := reg.ReadString('Mfg');
          result.HardwareID := Tstringlist.Create;
          ReadREG_MULTI_SZ(reg.CurrentKey, '', 'HardwareID', result.HardwareID);
          hwidcount := result.HardwareID.Count;
          if hwidcount > 0 then
          begin
            /// /USB\VID_22D9&PID_202D&MI_01
            result.VIDPID := result.HardwareID[1];
            result.VIDPID := trim(stringreplace(result.VIDPID, 'USB\', '', [rfReplaceAll]));
          end;

          if (reg.OpenKeyReadOnly('Device Parameters')) then
          begin
            result.DeviceParameters.PortName := reg.ReadString('PortName');
            if reg.ValueExists('SymbolicName') then
            begin
              result.DeviceParameters.SymbolicName := reg.ReadString('SymbolicName');
            end;
          end;

          break;
        end
        else
        begin
          if reg.OpenKeyReadOnly(ck) and reg.HasSubKeys then
          begin
            result := getUSBDeviceInfoByFriendlyname(ck, FriendlyName);
            // if rs <> '' then
            // break;
          end;
        end;
      end;
    end;

  finally
    reg.Free;
    k.Free;
  end;
end;

Function FindPorts(Filter: string = ''): TUSBDeviceList;
var
  sub: Tstringlist;
  i: integer;
begin
  sub := Tstringlist.Create;
  try
    FindAvailableCOM(sub);
    if sub.Count > 0 then
    begin
      setlength(result, sub.Count);
      for i := 0 to sub.Count - 1 do
      begin
        result[i] := getUSBDeviceInfoByFriendlyname('\System\CurrentControlSet\Enum\USB\', sub[i]);
        // log.addlog(sub[i]);
      end;
    end;
  finally
    sub.Free;
  end;

end;

Function ExtractVIDPID(symbolic: string): string;
var
  sub2: Tstringlist;
begin
  result := '';
  sub2 := Tstringlist.Create;
  try
    sub2.Delimiter := '#';
    sub2.DelimitedText := symbolic;
    if sub2.Count > 2 then
      result := lowercase(sub2[1]);
  finally
    sub2.Free;
  end;
end;

Function getPortFirst(frindlyname: string; timeout: integer = 1000): String;
var
  sub: Tstringlist;

  i, Count: integer;
  USBDeviceInfo: TUSBDeviceInfo;
begin
  sub := Tstringlist.Create;
  Count := 0;
  repeat
    application.ProcessMessages;
    Inc(Count);
   // log.Progress(Count, timeout);
    // FindAvailableCOM(Sub);
    FindDeviceList(sub, '{4D36E96D-E325-11CE-BFC1-08002BE10318}');

    // 4D36E96D-E325-11CE-BFC1-08002BE10318
    if sub.Count > 0 then
    begin
      for i := 0 to sub.Count - 1 do
      begin
        USBDeviceInfo := getUSBDeviceInfo(sub[i]);
        if AnsiContainsStr(USBDeviceInfo.FriendlyName, frindlyname) then
        begin
          result := sub[i];
          break;
        end;
      end;
    end;

    sleep(10);

  until (result <> '') or (Count = timeout);
  sub.Free;
  //
end;

end.

Share this post

Link to post

kvk1989    2

kvk1989
Posted

unit HW.FindDevice; interface // readonly string string_0 = "{4D36E96D-E325-11CE-BFC1-08002BE10318 } "; // readonly string string_1 = "F72FE0D4-CBCB-407d-8814-9ED673D0DD6B "; // readonly string string_2 = "F72FE0D4-CBCB-407d-8814-9ED673D0DD6B "; // readonly string string_3 = "{146bf252-9f25-4209-a6dd-c45a1180abc4}"; uses Winapi.Windows, Winapi.Messages, STRUTILS, forms, System.SysUtils, System.Win.Registry, System.Variants, System.Classes, SetupApi2, SetupAPI, inifiles; Type TSetofChars = Set of Char; TWUDFDiagnosticInfo = record HostPid: dword; IoctlTransferMode: dword; RetrievalMode: dword; RwTransferMode: dword; end; TDeviceParameters = record EnumerationRetryCount: dword; PollingPeriod: dword; PortName: ansistring; SymbolicName: string; WUDFDiagnosticInfo: TWUDFDiagnosticInfo; end; TUSBDeviceInfo = record VIDPID: string; Address: dword; Capabilities: dword; ClassGUID: ansistring; ContainerID: ansistring; device: string; DeviceDesc: ansistring; DriverGUID: ansistring; Driver: ansistring; FriendlyName: ansistring; HardwareID: Tstringlist; LocationInformation: ansistring; Mfg: ansistring; Service: ansistring; UpperFilters: string; DeviceParameters: TDeviceParameters; end; TUSBDeviceList = array of TUSBDeviceInfo; Function FindDevice(filterVid: string = ''): string; Function getUSBDeviceInfo(SymbolicName: string): TUSBDeviceInfo; Function FindDeviceList(var paths: Tstringlist; SEARCH_GUID_STR: string = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}'): integer; Procedure FindAvailableCOM(list: Tstrings); Function WaitDeviceDisconnected(symbolic: string; timeout: integer = 3000): boolean; Function FindPorts(Filter: string = ''): TUSBDeviceList; Function ExtractVIDPID(symbolic: string): string; Function getPortFirst(frindlyname: string; timeout: integer = 1000): String; implementation uses main; function findFriendlyName(key: string; Port: string): string; var r: TRegistry; k: Tstringlist; i: integer; ck: string; rs: string; begin r := TRegistry.Create(KEY_READ); k := Tstringlist.Create; r.RootKey := HKEY_LOCAL_MACHINE; r.OpenKeyReadOnly(key); r.GetKeyNames(k); r.CloseKey; try for i := 0 to k.Count - 1 do begin ck := key + k + '\'; // addlog(ck); if r.OpenKeyReadOnly(ck + 'Device Parameters') then begin if r.ReadString('PortName') = Port then begin r.CloseKey; r.OpenKeyReadOnly(ck); rs := r.ReadString('FriendlyName'); break; end end else begin if r.OpenKeyReadOnly(ck) and r.HasSubKeys then begin rs := findFriendlyName(ck, Port); if rs <> '' then break; end; end; end; result := rs; finally r.Free; k.Free; end; end; Procedure FindAvailableCOM(list: Tstrings); var GUID_CAM: TGUID; hDevInfo: Pointer; DeviceInfoData: SP_DEVINFO_DATA; successful: BOOL; i: dword; dwSize, dwPropertyRegDataType: dword; szDesc: array [0 .. 1023] of Char; begin list.Clear; GUID_CAM := StringToGUID('{4D36E978-E325-11CE-BFC1-08002BE10318}'); // GUID_CAM := StringToGUID('{4D36E96D-E325-11CE-BFC1-08002BE10318}'); // 4D36E96D-E325-11CE-BFC1-08002BE10318 // 4D36E978-E325-11CE-BFC1-08002BE10318 hDevInfo := SetupDiGetClassDevsW(@GUID_CAM, nil, 0, DIGCF_PRESENT); if dword(hDevInfo) <> INVALID_HANDLE_VALUE then begin i := 0; repeat DeviceInfoData.cbSize := SizeOf(TSP_DevInfo_Data); successful := SetupDiEnumDeviceInfo(hDevInfo, i, DeviceInfoData); if successful then begin if (SetupDiGetDeviceRegistryPropertyW(hDevInfo, @DeviceInfoData, SPDRP_FRIENDLYNAME, @dwPropertyRegDataType, @szDesc, SizeOf(szDesc), @dwSize)) then begin list.Add(WideCharToString(@szDesc)); // result := result + WideCharToString(@szDesc) + ';'; end; end; Inc(i); until not successful; end; end; // this function based on both: // http://www.delphikingdom.com/asp/answer.asp?IDAnswer=77001 // https://stackoverflow.com/questions/13927475/windows-how-to-enumerate-all-connected-usb-devices-device-path/13928035#13928035 // so we need modify this function and be creative { Result:= CreateFile( functionClassDeviceData^.DevicePath, GENERIC_WRITE or GENERIC_READ, 0, //FILE_SHARE_WRITE or FILE_SHARE_READ, Nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); } // Also this one // https://stackoverflow.com/questions/10154878/delphi-hid-in-delphi7-and-delphi-xe2 // is a good explanation how we can get info on devices function getGUIDevHandle(s: string; paths: Tstringlist): dword; var GD: TGUID; devInfoData: SP_DEVINFO_DATA; devInterfaceData: SP_DEVICE_INTERFACE_DATA; functionClassDeviceData: PSPInterfaceDeviceDetailData; requiredLength: dword; deviceNumber: integer; hwDeviceInfo: hDevInfo; predictedLength: cardinal; ok: boolean; path: string; begin result := 0; requiredLength := 0; GD := TGUID.Create(s); hwDeviceInfo := SetupDiGetClassDevs(@GD, Nil, 0, DIGCF_PRESENT or DIGCF_DEVICEINTERFACE); if (cardinal(hwDeviceInfo) <> INVALID_HANDLE_VALUE) then begin deviceNumber := 0; devInterfaceData.cbSize := SizeOf(devInterfaceData); while (SetupDiEnumDeviceInterfaces(hwDeviceInfo, Nil, GD, deviceNumber, devInterfaceData)) do begin // SetupDiGetInterfaceDeviceDetail SetupDiGetDeviceInterfaceDetail(hwDeviceInfo, @devInterfaceData, Nil, 0, requiredLength, Nil); predictedLength := requiredLength; functionClassDeviceData := PSPInterfaceDeviceDetailData(GlobalAlloc(GPTR, predictedLength)); functionClassDeviceData^.cbSize := SizeOf(TSPDeviceInterfaceDetailData); // ???? - âńĺ îę devInfoData.cbSize := SizeOf(devInfoData); if (SetupDiGetDeviceInterfaceDetail(hwDeviceInfo, @devInterfaceData, functionClassDeviceData, predictedLength, requiredLength, @devInfoData)) then begin path := PAnsiChar(@(functionClassDeviceData^.DevicePath)); // dlog(path); paths.Add(path); end; GlobalFree(cardinal(functionClassDeviceData)); Inc(deviceNumber); end; // if (SetupDiEnumDeviceInterfaces ( hwDeviceInfo, Nil, GD, deviceNumber, devInterfaceData)) SetupDiDestroyDeviceInfoList(hwDeviceInfo); end; // if hwDeviceInfo <> INVALID_HANDLE_VALUE if result = INVALID_HANDLE_VALUE then result := 0; end; Function FindDevice(filterVid: string = ''): string; const SEARCH_GUID_STR = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}'; var i: integer; paths: Tstringlist; begin result := ''; paths := Tstringlist.Create; getGUIDevHandle(SEARCH_GUID_STR, paths); for i := 0 to paths.Count - 1 do begin if lowercase(paths).Contains(lowercase(filterVid)) then // 'vid_05c6' begin result := paths; break; end; end; paths.Free; end; Function FindDeviceList(var paths: Tstringlist; SEARCH_GUID_STR: string = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}'): integer; // const // SEARCH_GUID_STR = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}'; begin result := 0; getGUIDevHandle(SEARCH_GUID_STR, paths); result := paths.Count; end; Function WaitDeviceDisconnected(symbolic: string; timeout: integer = 3000): boolean; var sub: Tstringlist; i: integer; symbolic_: string; Stillfound: boolean; loopcount: integer; begin result := false; /// log.debug(symbolic); sub := Tstringlist.Create; try Stillfound := true; loopcount := 0; repeat Inc(loopcount); // log.ProgGauge(loopcount, timeout); sub.Clear; FindDeviceList(sub); application.ProcessMessages; if sub.Count > 0 then begin Stillfound := false; for i := 0 to sub.Count - 1 do begin application.ProcessMessages; symbolic_ := lowercase(sub); if lowercase(symbolic_) = lowercase(symbolic) then Stillfound := true; end; if Stillfound = false then break; end; sleep(1); until (loopcount >= timeout) or (Stillfound = false); finally sub.Free; end; if Stillfound then // log.debug('Stillfound') else // log.debug('not found'); end; Function getDriverDetails(DeviceDesc: ansistring): string; var ini: Tinifile; windir: string; sub: Tstringlist; i: integer; inf: string; PWindowsDir: array [0 .. 255] of Char; begin // get windows folder GetWindowsDirectory(PWindowsDir, 255); sub := Tstringlist.Create; // sub.Delimiter := '%'; // sub.Text := DeviceDesc; sub.DelimitedText := DeviceDesc; inf := Copy(trim(sub[0]), 2); windir := trim(PWindowsDir) + '\INF\' + inf; // addlog(windir); if fileexists(windir) then begin ini := Tinifile.Create(windir); result := ini.ReadString('Version', 'DriverVer', ''); ini.Free; end; end; Function getUSBDeviceInfo(SymbolicName: string): TUSBDeviceInfo; var sub: Tstringlist; DeviceNamesArray: TUSBDeviceList; i, c, idx, max: integer; reg: TRegistry; Tmp: string; VIDPID: string; begin if trim(SymbolicName) = '' then exit; sub := Tstringlist.Create; try sub.Delimiter := '#'; sub.DelimitedText := lowercase(SymbolicName); { \\?\usb vid_05c6&pid_9008 7&10efe18c&0&1 {a5dcbf10-6530-11d2-901f-00c04fb951ed } // } if sub.Count > 2 then begin reg := TRegistry.Create; try reg.RootKey := HKEY_LOCAL_MACHINE; if reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Enum\USB\' + sub[1]) then begin if (reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Enum\USB\' + sub[1] + '\' + sub[2])) then begin result.DeviceParameters.SymbolicName := ''; result.device := sub[2]; result.LocationInformation := reg.ReadString('LocationInformation'); // Az eszköz leírása result.DeviceDesc := reg.ReadString('DeviceDesc'); // Az eszköz leírása result.ClassGUID := reg.ReadString('ClassGUID'); // Az eszköz leírása result.ContainerID := reg.ReadString('ContainerID'); // Az eszköz leírása result.FriendlyName := reg.ReadString('FriendlyName'); // Az eszköz leírása result.Service := reg.ReadString('Service'); // Az eszköz leírása result.Driver := getDriverDetails(result.DeviceDesc); result.DriverGUID := reg.ReadString('Driver'); result.Mfg := reg.ReadString('Mfg'); if (reg.OpenKeyReadOnly('Device Parameters')) then begin result.DeviceParameters.PortName := reg.ReadString('PortName'); if reg.ValueExists('SymbolicName') then begin result.DeviceParameters.SymbolicName := reg.ReadString('SymbolicName'); end; end; end; end; finally reg.Free; end; end; finally sub.Free; end; end; procedure ReadREG_MULTI_SZ(const CurrentKey: HKey; const Subkey, ValueName: string; Strings: Tstrings); var valueType: dword; valueLen: dword; p, buffer: PChar; key: HKey; begin // Clear TStrings // TStrings leeren Strings.Clear; // open the specified key // CurrentKey Schlüssel öffnen if RegOpenKeyEx(CurrentKey, PChar(Subkey), 0, KEY_READ, key) = ERROR_SUCCESS then begin // retrieve the type and data for a specified value name // Den Typ und Wert des Eintrags Ermitteln. SetLastError(RegQueryValueEx(key, PChar(ValueName), nil, @valueType, nil, @valueLen)); if GetLastError = ERROR_SUCCESS then if valueType = REG_MULTI_SZ then begin GetMem(buffer, valueLen); try // receive the value's data (in an array). // Ein Array von Null-terminierten Strings // wird zurückgegeben RegQueryValueEx(key, PChar(ValueName), nil, nil, PBYTE(buffer), @valueLen); // Add values to stringlist // Werte in String Liste einfügen p := buffer; while p^ <> #0 do begin Strings.Add(p); Inc(p, lstrlen(p) + 1) end finally FreeMem(buffer) end end else raise ERegistryException.Create('Stringlist expected/ String Liste erwartet...') else raise ERegistryException.Create('Cannot Read MULTI_SZ Value/' + 'Kann den MULTI_SZ Wert nicht lesen...'); end; end; function getUSBDeviceInfoByFriendlyname(key: string; FriendlyName: string): TUSBDeviceInfo; var reg: TRegistry; k: Tstringlist; i: integer; ck: string; rs: string; fn: string; hwidcount: integer; begin reg := TRegistry.Create(KEY_READ); k := Tstringlist.Create; reg.RootKey := HKEY_LOCAL_MACHINE; // key := '\System\CurrentControlSet\Enum\USB\'; reg.OpenKeyReadOnly(key); reg.GetKeyNames(k); reg.CloseKey; try for i := 0 to k.Count - 1 do begin ck := key + k + '\'; if reg.OpenKeyReadOnly(ck) then begin if reg.ReadString('FriendlyName') = FriendlyName then begin result.DeviceParameters.SymbolicName := ''; result.device := k; result.LocationInformation := reg.ReadString('LocationInformation'); // Az eszköz leírása result.DeviceDesc := reg.ReadString('DeviceDesc'); // Az eszköz leírása result.ClassGUID := reg.ReadString('ClassGUID'); // Az eszköz leírása result.ContainerID := reg.ReadString('ContainerID'); // Az eszköz leírása result.FriendlyName := reg.ReadString('FriendlyName'); // Az eszköz leírása result.Service := reg.ReadString('Service'); // Az eszköz leírása result.Driver := getDriverDetails(result.DeviceDesc); result.DriverGUID := reg.ReadString('Driver'); result.Mfg := reg.ReadString('Mfg'); result.HardwareID := Tstringlist.Create; ReadREG_MULTI_SZ(reg.CurrentKey, '', 'HardwareID', result.HardwareID); hwidcount := result.HardwareID.Count; if hwidcount > 0 then begin /// /USB\VID_22D9&PID_202D&MI_01 result.VIDPID := result.HardwareID[1]; result.VIDPID := trim(stringreplace(result.VIDPID, 'USB\', '', [rfReplaceAll])); end; if (reg.OpenKeyReadOnly('Device Parameters')) then begin result.DeviceParameters.PortName := reg.ReadString('PortName'); if reg.ValueExists('SymbolicName') then begin result.DeviceParameters.SymbolicName := reg.ReadString('SymbolicName'); end; end; break; end else begin if reg.OpenKeyReadOnly(ck) and reg.HasSubKeys then begin result := getUSBDeviceInfoByFriendlyname(ck, FriendlyName); // if rs <> '' then // break; end; end; end; end; finally reg.Free; k.Free; end; end; Function FindPorts(Filter: string = ''): TUSBDeviceList; var sub: Tstringlist; i: integer; begin sub := Tstringlist.Create; try FindAvailableCOM(sub); if sub.Count > 0 then begin setlength(result, sub.Count); for i := 0 to sub.Count - 1 do begin result := getUSBDeviceInfoByFriendlyname('\System\CurrentControlSet\Enum\USB\', sub); // log.addlog(sub); end; end; finally sub.Free; end; end; Function ExtractVIDPID(symbolic: string): string; var sub2: Tstringlist; begin result := ''; sub2 := Tstringlist.Create; try sub2.Delimiter := '#'; sub2.DelimitedText := symbolic; if sub2.Count > 2 then result := lowercase(sub2[1]); finally sub2.Free; end; end; Function getPortFirst(frindlyname: string; timeout: integer = 1000): String; var sub: Tstringlist; i, Count: integer; USBDeviceInfo: TUSBDeviceInfo; begin sub := Tstringlist.Create; Count := 0; repeat application.ProcessMessages; Inc(Count); // log.Progress(Count, timeout); // FindAvailableCOM(Sub); FindDeviceList(sub, '{4D36E96D-E325-11CE-BFC1-08002BE10318}'); // 4D36E96D-E325-11CE-BFC1-08002BE10318 if sub.Count > 0 then begin for i := 0 to sub.Count - 1 do begin USBDeviceInfo := getUSBDeviceInfo(sub); if AnsiContainsStr(USBDeviceInfo.FriendlyName, frindlyname) then begin result := sub; break; end; end; end; sleep(10); until (result <> '') or (Count = timeout); sub.Free; // end; end.

Share this post

Link to post

kvk1989    2

kvk1989
Posted
17 hours ago, Remy Lebeau said:

Your formatting is all messed up, please fix it. 

unit HW.FindDevice;

interface

uses
  Winapi.Windows, Winapi.Messages, STRUTILS, forms,
  System.SysUtils, System.Win.Registry, System.Variants, System.Classes,
  SetupApi2, SetupAPI, inifiles;

Type
  TSetofChars = Set of Char;

  TWUDFDiagnosticInfo = record
    HostPid: DWORD;
    IoctlTransferMode: DWORD;
    RetrievalMode: DWORD;
    RwTransferMode: DWORD;
  end;

  TDeviceParameters = record
    EnumerationRetryCount: DWORD;
    PollingPeriod: DWORD;
    PortName: AnsiString;
    SymbolicName: string;
    WUDFDiagnosticInfo: TWUDFDiagnosticInfo;
  end;

  TUSBDeviceInfo = record
    VIDPID: string;
    Address: DWORD;
    Capabilities: DWORD;
    ClassGUID: AnsiString;
    ContainerID: AnsiString;
    device: string;
    DeviceDesc: AnsiString;
    DriverGUID: AnsiString;
    Driver: AnsiString;
    FriendlyName: AnsiString;
    HardwareID: TStringList;
    LocationInformation: AnsiString;
    Mfg: AnsiString;
    Service: AnsiString;
    UpperFilters: string;
    DeviceParameters: TDeviceParameters;
  end;

  TUSBDeviceList = array of TUSBDeviceInfo;

Function FindDevice(filterVid: string = ''): string;
Function getUSBDeviceInfo(SymbolicName: string): TUSBDeviceInfo;

Function FindDeviceList(var paths: TStringList;
  SEARCH_GUID_STR: string = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}'): integer;
Procedure FindAvailableCOM(list: Tstrings);
Function WaitDeviceDisconnected(symbolic: string;
  timeout: integer = 3000): boolean;

Function FindPorts(Filter: string = ''): TUSBDeviceList;
Function ExtractVIDPID(symbolic: string): string;
Function getPortFirst(frindlyname: string; timeout: integer = 1000): String;
function ContainsMediaTekPort(PortName: string): boolean;

implementation

uses main;

procedure Log(const Msg: string);
var
  LogFile: TextFile;
begin
  AssignFile(LogFile, 'DebugLog.txt');
  if FileExists('DebugLog.txt') then
    Append(LogFile)
  else
    Rewrite(LogFile);
  Writeln(LogFile, Msg);
  CloseFile(LogFile);
end;

function ContainsMediaTekPort(PortName: string): boolean;
begin
  Result := Pos('MediaTek USB Port_V1633', PortName) > 0;
  if Result then
    Log('MediaTek port found: ' + PortName)
  else
    Log('MediaTek port not found: ' + PortName);
end;

Function FindPorts(Filter: string = ''): TUSBDeviceList;
var
  sub: TStringList;
  i: integer;
begin
  sub := TStringList.Create;
  try
    FindAvailableCOM(sub);
    if sub.Count > 0 then
    begin
      SetLength(Result, sub.Count);
      for i := 0 to sub.Count - 1 do
      begin

        if ContainsMediaTekPort(sub[i]) then
          Result[i] := getUSBDeviceInfo(sub[i])
        else
          Result[i] := Default (TUSBDeviceInfo);
      end;
    end;
  finally
    sub.Free;
  end;
end;

function findFriendlyName(key: string; Port: string): string;
var
  r: TRegistry;
  k: TStringList;
  i: integer;
  ck: string;
  rs: string;
begin
  r := TRegistry.Create(KEY_READ);
  k := TStringList.Create;
  r.RootKey := HKEY_LOCAL_MACHINE;
  r.OpenKeyReadOnly(key);
  r.GetKeyNames(k);
  r.CloseKey;
  try
    for i := 0 to k.Count - 1 do
    begin
      ck := key + k[i] + '\';
      // addlog(ck);
      if r.OpenKeyReadOnly(ck + 'Device Parameters') then
      begin
        if r.ReadString('PortName') = Port then
        begin
          r.CloseKey;
          r.OpenKeyReadOnly(ck);
          rs := r.ReadString('FriendlyName');
          break;
        end
      end
      else
      begin
        if r.OpenKeyReadOnly(ck) and r.HasSubKeys then
        begin
          rs := findFriendlyName(ck, Port);
          if rs <> '' then
            break;
        end;
      end;
    end;
    Result := rs;
  finally
    r.Free;
    k.Free;
  end;
end;

Procedure FindAvailableCOM(list: Tstrings);
var
  GUID_CAM: TGUID;
  hDevInfo: Pointer;
  DeviceInfoData: SP_DEVINFO_DATA;
  successful: BOOL;
  i: DWORD;
  dwSize, dwPropertyRegDataType: DWORD;
  szDesc: array [0 .. 1023] of Char;
begin
  list.Clear;
  GUID_CAM := StringToGUID('{4D36E978-E325-11CE-BFC1-08002BE10318}');
  hDevInfo := SetupDiGetClassDevsW(@GUID_CAM, nil, 0, DIGCF_PRESENT);
  if DWORD(hDevInfo) <> INVALID_HANDLE_VALUE then
  begin
    i := 0;
    repeat
      DeviceInfoData.cbSize := SizeOf(TSP_DevInfo_Data);
      successful := SetupDiEnumDeviceInfo(hDevInfo, i, DeviceInfoData);
      if successful then
      begin
        if (SetupDiGetDeviceRegistryPropertyW(hDevInfo, @DeviceInfoData,
          SPDRP_FRIENDLYNAME, @dwPropertyRegDataType, @szDesc, SizeOf(szDesc),
          @dwSize)) then
        begin
          list.Add(WideCharToString(@szDesc));

        end;
      end;
      Inc(i);
    until not successful;
  end;
end;

function getGUIDevHandle(s: string; paths: TStringList): DWORD;
var
  GD: TGUID;
  devInfoData: SP_DEVINFO_DATA;
  devInterfaceData: SP_DEVICE_INTERFACE_DATA;
  functionClassDeviceData: PSPInterfaceDeviceDetailData;
  requiredLength: DWORD;
  deviceNumber: integer;
  hwDeviceInfo: hDevInfo;
  predictedLength: cardinal;
  ok: boolean;
  path: string;
begin
  Result := 0;
  requiredLength := 0;
  GD := TGUID.Create(s);
  hwDeviceInfo := SetupDiGetClassDevs(@GD, Nil, 0, DIGCF_PRESENT or
    DIGCF_DEVICEINTERFACE);

  if (cardinal(hwDeviceInfo) <> INVALID_HANDLE_VALUE) then
  begin
    deviceNumber := 0;
    devInterfaceData.cbSize := SizeOf(devInterfaceData);
    while (SetupDiEnumDeviceInterfaces(hwDeviceInfo, Nil, GD, deviceNumber,
      devInterfaceData)) do
    begin

      SetupDiGetDeviceInterfaceDetail(hwDeviceInfo, @devInterfaceData, Nil, 0,
        requiredLength, Nil);
      predictedLength := requiredLength;
      functionClassDeviceData := PSPInterfaceDeviceDetailData
        (GlobalAlloc(GPTR, predictedLength));
      functionClassDeviceData^.cbSize := SizeOf(TSPDeviceInterfaceDetailData);
      // ???? - âñå îê
      devInfoData.cbSize := SizeOf(devInfoData);
      if (SetupDiGetDeviceInterfaceDetail(hwDeviceInfo, @devInterfaceData,
        functionClassDeviceData, predictedLength, requiredLength, @devInfoData))
      then
      begin
        path := PAnsiChar(@(functionClassDeviceData^.DevicePath));
        // dlog(path);
        paths.Add(path);
      end;

      GlobalFree(cardinal(functionClassDeviceData));
      Inc(deviceNumber);
    end;

    SetupDiDestroyDeviceInfoList(hwDeviceInfo);
  end;
  if Result = INVALID_HANDLE_VALUE then
    Result := 0;
end;

Function FindDevice(filterVid: string = ''): string;
const
  SEARCH_GUID_STR = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
var
  i: integer;
  paths: TStringList;
begin
  Result := '';
  paths := TStringList.Create;
  getGUIDevHandle(SEARCH_GUID_STR, paths);
  for i := 0 to paths.Count - 1 do
  begin
    if lowercase(paths[i]).Contains(lowercase(filterVid)) then // 'vid_05c6'
    begin
      Result := paths[i];
      break;
    end;
  end;
  paths.Free;
end;

Function FindDeviceList(var paths: TStringList;
  SEARCH_GUID_STR: string = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}'): integer;

begin
  Result := 0;
  getGUIDevHandle(SEARCH_GUID_STR, paths);
  Result := paths.Count;
end;

Function WaitDeviceDisconnected(symbolic: string;
  timeout: integer = 3000): boolean;
var
  sub: TStringList;
  i: integer;
  symbolic_: string;
  Stillfound: boolean;
  loopcount: integer;
begin
  Result := false;
  /// log.debug(symbolic);
  sub := TStringList.Create;
  try
    Stillfound := true;
    loopcount := 0;
    repeat
      Inc(loopcount);
      // log.ProgGauge(loopcount, timeout);
      sub.Clear;
      FindDeviceList(sub);
      application.ProcessMessages;
      if sub.Count > 0 then
      begin
        Stillfound := false;
        for i := 0 to sub.Count - 1 do
        begin
          application.ProcessMessages;
          symbolic_ := lowercase(sub[i]);
          if lowercase(symbolic_) = lowercase(symbolic) then
            Stillfound := true;

        end;
        if Stillfound = false then
          break;
      end;
      sleep(1);
    until (loopcount >= timeout) or (Stillfound = false);
  finally
    sub.Free;
  end;

  if Stillfound then
    // log.debug('Stillfound')
  else
    // log.debug('not found');
end;

Function getDriverDetails(DeviceDesc: AnsiString): string;
var
  ini: Tinifile;
  windir: string;
  sub: TStringList;
  i: integer;
  inf: string;

  PWindowsDir: array [0 .. 255] of Char;
begin
  GetWindowsDirectory(PWindowsDir, 255);
  sub := TStringList.Create;
  sub.DelimitedText := DeviceDesc;
  inf := Copy(trim(sub[0]), 2);
  windir := trim(PWindowsDir) + '\INF\' + inf;
  if FileExists(windir) then
  begin
    ini := Tinifile.Create(windir);
    Result := ini.ReadString('Version', 'DriverVer', '');
    ini.Free;
  end;

end;

Function getUSBDeviceInfo(SymbolicName: string): TUSBDeviceInfo;
var
  sub: TStringList;
  DeviceNamesArray: TUSBDeviceList;
  i, c, idx, max: integer;
  reg: TRegistry;
  Tmp: string;
  VIDPID: string;

begin
  if trim(SymbolicName) = '' then
    exit;
  sub := TStringList.Create;
  try
    sub.Delimiter := '#';
    sub.DelimitedText := lowercase(SymbolicName);
    if sub.Count > 2 then
    begin
      reg := TRegistry.Create;
      try
        reg.RootKey := HKEY_LOCAL_MACHINE;
        if reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Enum\USB\' + sub[1])
        then
        begin
          if (reg.OpenKeyReadOnly('\SYSTEM\CurrentControlSet\Enum\USB\' + sub[1]
            + '\' + sub[2])) then
          begin
            Result.DeviceParameters.SymbolicName := '';
            Result.device := sub[2];
            Result.LocationInformation := reg.ReadString('LocationInformation');
            // Az eszköz leírása
            Result.DeviceDesc := reg.ReadString('DeviceDesc');
            // Az eszköz leírása
            Result.ClassGUID := reg.ReadString('ClassGUID');
            // Az eszköz leírása
            Result.ContainerID := reg.ReadString('ContainerID');
            // Az eszköz leírása
            Result.FriendlyName := reg.ReadString('FriendlyName');
            // Az eszköz leírása
            Result.Service := reg.ReadString('Service'); // Az eszköz leírása
            Result.Driver := getDriverDetails(Result.DeviceDesc);
            Result.DriverGUID := reg.ReadString('Driver');
            Result.Mfg := reg.ReadString('Mfg');
            if (reg.OpenKeyReadOnly('Device Parameters')) then
            begin
              Result.DeviceParameters.PortName := reg.ReadString('PortName');
              if reg.ValueExists('SymbolicName') then
              begin
                Result.DeviceParameters.SymbolicName :=
                  reg.ReadString('SymbolicName');
              end;
            end;

          end;
        end;
      finally
        reg.Free;
      end;
    end;
  finally
    sub.Free;
  end;

end;

procedure ReadREG_MULTI_SZ(const CurrentKey: HKey;
  const Subkey, ValueName: string; Strings: Tstrings);
var
  valueType: DWORD;
  valueLen: DWORD;
  p, buffer: PChar;
  key: HKey;
begin

  Strings.Clear;
  if RegOpenKeyEx(CurrentKey, PChar(Subkey), 0, KEY_READ, key) = ERROR_SUCCESS
  then
  begin
    SetLastError(RegQueryValueEx(key, PChar(ValueName), nil, @valueType, nil,
      @valueLen));
    if GetLastError = ERROR_SUCCESS then
      if valueType = REG_MULTI_SZ then
      begin
        GetMem(buffer, valueLen);
        try

          RegQueryValueEx(key, PChar(ValueName), nil, nil, PBYTE(buffer),
            @valueLen);

          p := buffer;
          while p^ <> #0 do
          begin
            Strings.Add(p);
            Inc(p, lstrlen(p) + 1)
          end
        finally
          FreeMem(buffer)
        end
      end
      else
        raise ERegistryException.Create
          ('Stringlist expected/ String Liste erwartet...')
    else
      raise ERegistryException.Create('Cannot Read MULTI_SZ Value/' +
        'Kann den MULTI_SZ Wert nicht lesen...');
  end;
end;

function getUSBDeviceInfoByFriendlyname(key: string; FriendlyName: string)
  : TUSBDeviceInfo;
var
  reg: TRegistry;
  k: TStringList;
  i: integer;
  ck: string;
  rs: string;

  fn: string;
  hwidcount: integer;
begin
  reg := TRegistry.Create(KEY_READ);
  k := TStringList.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;

  reg.OpenKeyReadOnly(key);
  reg.GetKeyNames(k);
  reg.CloseKey;
  try
    for i := 0 to k.Count - 1 do
    begin
      ck := key + k[i] + '\';
      if reg.OpenKeyReadOnly(ck) then
      begin
        if reg.ReadString('FriendlyName') = FriendlyName then
        begin
          Result.DeviceParameters.SymbolicName := '';
          Result.device := k[i];
          Result.LocationInformation := reg.ReadString('LocationInformation');
          // Az eszköz leírása
          Result.DeviceDesc := reg.ReadString('DeviceDesc');
          // Az eszköz leírása
          Result.ClassGUID := reg.ReadString('ClassGUID'); // Az eszköz leírása
          Result.ContainerID := reg.ReadString('ContainerID');
          // Az eszköz leírása
          Result.FriendlyName := reg.ReadString('FriendlyName');
          // Az eszköz leírása
          Result.Service := reg.ReadString('Service'); // Az eszköz leírása
          Result.Driver := getDriverDetails(Result.DeviceDesc);
          Result.DriverGUID := reg.ReadString('Driver');
          Result.Mfg := reg.ReadString('Mfg');
          Result.HardwareID := TStringList.Create;
          ReadREG_MULTI_SZ(reg.CurrentKey, '', 'HardwareID', Result.HardwareID);
          hwidcount := Result.HardwareID.Count;
          if hwidcount > 0 then
          begin
            /// /USB\VID_22D9&PID_202D&MI_01
            Result.VIDPID := Result.HardwareID[1];
            Result.VIDPID := trim(stringreplace(Result.VIDPID, 'USB\', '',
              [rfReplaceAll]));
          end;

          if (reg.OpenKeyReadOnly('Device Parameters')) then
          begin
            Result.DeviceParameters.PortName := reg.ReadString('PortName');
            if reg.ValueExists('SymbolicName') then
            begin
              Result.DeviceParameters.SymbolicName :=
                reg.ReadString('SymbolicName');
            end;
          end;

          break;
        end
        else
        begin
          if reg.OpenKeyReadOnly(ck) and reg.HasSubKeys then
          begin
            Result := getUSBDeviceInfoByFriendlyname(ck, FriendlyName);
            // if rs <> '' then
            // break;
          end;
        end;
      end;
    end;

  finally
    reg.Free;
    k.Free;
  end;
end;

{ Function FindPorts(Filter: string = ''): TUSBDeviceList;
  var
  sub: TStringList;
  i: integer;
  begin
  sub := TStringList.Create;
  try
  FindAvailableCOM(sub);
  if sub.Count > 0 then
  begin
  SetLength(Result, sub.Count);
  for i := 0 to sub.Count - 1 do
  begin
  Result[i] := getUSBDeviceInfoByFriendlyname
  ('\System\CurrentControlSet\Enum\USB\', sub[i]);
  // log.addlog(sub[i]);
  end;
  end;
  finally
  sub.Free;
  end;

  end; }

Function ExtractVIDPID(symbolic: string): string;
var
  sub2: TStringList;
begin
  Result := '';
  sub2 := TStringList.Create;
  try
    sub2.Delimiter := '#';
    sub2.DelimitedText := symbolic;
    if sub2.Count > 2 then
      Result := lowercase(sub2[1]);
  finally
    sub2.Free;
  end;
end;

Function getPortFirst(frindlyname: string; timeout: integer = 1000): String;
var
  sub: TStringList;

  i, Count: integer;
  USBDeviceInfo: TUSBDeviceInfo;
begin
  sub := TStringList.Create;
  Count := 0;
  repeat
    application.ProcessMessages;
    Inc(Count);
    // log.Progress(Count, timeout);
    // FindAvailableCOM(Sub);
    FindDeviceList(sub, '{4D36E96D-E325-11CE-BFC1-08002BE10318}');

    // 4D36E96D-E325-11CE-BFC1-08002BE10318
    if sub.Count > 0 then
    begin
      for i := 0 to sub.Count - 1 do
      begin
        USBDeviceInfo := getUSBDeviceInfo(sub[i]);
        if AnsiContainsStr(USBDeviceInfo.FriendlyName, frindlyname) then
        begin
          Result := sub[i];
          break;
        end;
      end;
    end;

    sleep(10);

  until (Result <> '') or (Count = timeout);
  sub.Free;
  //
end;

end.

 

Share this post

Link to post

Remy Lebeau    1264

Remy Lebeau
Posted

That is a LOT of code to go through, I'm betting most of it is irrelevant to the problem at hand.  And it doesn't even include your UI code that is displaying the "not found" error, so I don't even know which portions of this code are actually being exercised.

Share this post

Link to post

kvk1989    2

kvk1989
Posted
12 hours ago, Remy Lebeau said:

That is a LOT of code to go through, I'm betting most of it is irrelevant to the problem at hand.  And it doesn't even include your UI code that is displaying the "not found" error, so I don't even know which portions of this code are actually being exercised. 

procedure TForm13.Button3Click(Sender: TObject);
var
  Ports: TUSBDeviceList;
  MediaTekPortFound: Boolean;
  i: Integer;
begin
  MediaTekPortFound := False;
  Ports := FindPorts;
  for i := 0 to Length(Ports) - 1 do
  begin
    if ContainsMediaTekPort(Ports[i].DeviceParameters.PortName) then
    begin
      MediaTekPortFound := True;
      LogPortCheckingInfo('MediaTek port found: ' + Ports[i].DeviceParameters.PortName);
      Break;
    end;
  end;
  if MediaTekPortFound then
  begin
    ShowMessage('MediaTek port found.');
    LogPortCheckingInfo('MediaTek port found.');
  end
  else
  begin
    LogPortCheckingInfo('MediaTek port not found.');
    ShowMessage('MediaTek port not found.');
  end;
end;

 

Share this post

Link to post

Remy Lebeau    1264

Remy Lebeau
Posted (edited)

Your getUSBDeviceInfo() function requires a symbolic name containing at least 2 '#' chars in it, but the ports you are testing with don't have any '#' chars in their names at all.

 

When your TButton.OnClick handler calls FindPorts(), it gets the device list and checks each device name with ContainsMediaTekPort().  You are recording the result of that check to the log file, which is why you see the device being found.  And then, if a matching name is found then the subsequent call to getUSBDeviceInfo() fails to parse the device name, thus skipping the retrieval of that device's info from the Registry.

 

Your OnClick handler is then looping through the returned device array, checking each device's PortName for the device name (which in of itself is wrong since the PortName is different than the device name), and since the PortName was never being populated, that is why you see the "not found" error.

 

You should have been able to discover this problem for yourself if you had stepped through your code with the debugger line-by-line and noticed that getUSBDeviceInfo() was never reading from the Registry.

 

You need to fix this parsing problem so that getUSBDeviceInfo() actually returns the data you are expecting.

 

Aside from that, just from a design perspective, I would strongly recommend changing FindPorts() to NOT include 'default' entries in the returned array.  When you are filtering for a specific type of port, that is all you should be returning, eg: 

Function FindPorts(Filter: string = ''): TUSBDeviceList;
var
  sub: TStringList;
  i: integer;
begin
  sub := TStringList.Create;
  try
    FindAvailableCOM(sub);
    if Filter <> '' then
    begin
      for i := sub.Count - 1 downto 0 do
      begin
        if Pos(Filter, sub[i]) = 0 then
          sub.Delete(i);
      end;
    end;
    SetLength(Result, sub.Count);
    for i := 0 to sub.Count - 1 do
      Result[i] := getUSBDeviceInfo(sub[i]);
  finally
    sub.Free;
  end;
end;

...

procedure TForm13.Button3Click(Sender: TObject);
var
  Ports: TUSBDeviceList;
begin
  Ports := FindPorts('MediaTek USB Port_V1633');
  if Length(Ports) > 0 then
  begin
    LogPortCheckingInfo('MediaTek port found: ' + Ports[0].DeviceParameters.PortName);
    ShowMessage('MediaTek port found.');
  end else
  begin
    LogPortCheckingInfo('MediaTek port not found.');
    ShowMessage('MediaTek port not found.');
  end;
end;

Now, all of that being said, I do also notice a number of other mistakes and general problems with the code you have provided, such as lack of adequate error handling, use of incorrect data types, etc.  It could really benefit from a good code review and cleanup in general.

Edited by Remy Lebeau

Share this post

Link to post

kvk1989    2

kvk1989
Posted
17 hours ago, Remy Lebeau said:

Your getUSBDeviceInfo() function requires a symbolic name containing at least 2 '#' chars in it, but the ports you are testing with don't have any '#' chars in their names at all.

 

When your TButton.OnClick handler calls FindPorts(), it gets the device list and checks each device name with ContainsMediaTekPort().  You are recording the result of that check to the log file, which is why you see the device being found.  And then, if a matching name is found then the subsequent call to getUSBDeviceInfo() fails to parse the device name, thus skipping the retrieval of that device's info from the Registry.

 

Your OnClick handler is then looping through the returned device array, checking each device's PortName for the device name (which in of itself is wrong since the PortName is different than the device name), and since the PortName was never being populated, that is why you see the "not found" error.

 

You should have been able to discover this problem for yourself if you had stepped through your code with the debugger line-by-line and noticed that getUSBDeviceInfo() was never reading from the Registry.

 

You need to fix this parsing problem so that getUSBDeviceInfo() actually returns the data you are expecting.

 

Aside from that, just from a design perspective, I would strongly recommend changing FindPorts() to NOT include 'default' entries in the returned array.  When you are filtering for a specific type of port, that is all you should be returning, eg: 


Function FindPorts(Filter: string = ''): TUSBDeviceList;
var
  sub: TStringList;
  i: integer;
begin
  sub := TStringList.Create;
  try
    FindAvailableCOM(sub);
    if Filter <> '' then
    begin
      for i := sub.Count - 1 downto 0 do
      begin
        if Pos(Filter, sub[i]) = 0 then
          sub.Delete(i);
      end;
    end;
    SetLength(Result, sub.Count);
    for i := 0 to sub.Count - 1 do
      Result[i] := getUSBDeviceInfo(sub[i]);
  finally
    sub.Free;
  end;
end;

...

procedure TForm13.Button3Click(Sender: TObject);
var
  Ports: TUSBDeviceList;
begin
  Ports := FindPorts('MediaTek USB Port_V1633');
  if Length(Ports) > 0 then
  begin
    LogPortCheckingInfo('MediaTek port found: ' + Ports[0].DeviceParameters.PortName);
    ShowMessage('MediaTek port found.');
  end else
  begin
    LogPortCheckingInfo('MediaTek port not found.');
    ShowMessage('MediaTek port not found.');
  end;
end;

Now, all of that being said, I do also notice a number of other mistakes and general problems with the code you have provided, such as lack of adequate error handling, use of incorrect data types, etc.  It could really benefit from a good code review and cleanup in general.

thanks ! can  i upload here full project ?

 

Share this post

Link to post

Angus Robertson    527

Angus Robertson
Posted

If you are attempting to locate COM ports on Windows, I suggest you use the Magenta Serial Port Detection Component from https://www.magsys.co.uk/delphi/maghardware.asp

 

It has an event that triggers as ports arrive and disappear. It returns an array with information about each port, and whether enabled or hidden:

 

COM1, Enabled=Y, Communications Port (COM1), (Standard port types), Serial0, ACPI\VEN_PNP&DEV_0501,
COM2, Enabled=Y, PCIe to High Speed Serial Port (COM2), ASIX Electronics Corporation, StnSerial0, MCS9950MF\STN_CASCADE_COM,
COM3, Enabled=Y, PCIe to High Speed Serial Port (COM3), ASIX Electronics Corporation, StnSerial1, MCS9950MF\STN_CASCADE_COM,
COM4, Enabled=Y, Prolific USB-to-Serial Comm Port (COM4), Prolific, ProlificSerial0, USB\VID_067B&PID_2303&REV_0400, Port_#0004.Hub_#0007
COM5, Enabled=Y, Prolific USB-to-Serial Comm Port (COM5), Prolific, ProlificSerial1, USB\VID_067B&PID_2303&REV_0400, Port_#0001.Hub_#0007
COM6, Enabled=Y, Conexant USB CX93010 ACF Modem, Conexant, USBSER000, USB\VID_0572&PID_1329&REV_0100, Port_#0007.Hub_#0001
COM7, Enabled=Y, USB Serial Device (COM7), Microsoft, USBSER000, USB\VID_1546&PID_01A8&REV_0201, Port_#0002.Hub_#0007

 

Angus

 

Share this post

Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Go To Topic Listing General Help
×