Jump to content

kvk1989

Members
  • Content Count

    71
  • Joined

  • Last visited

Community Reputation

2 Neutral

1 Follower

Technical Information

  • Delphi-Version
    Delphi 10.4 Sydney

Recent Profile Visitors

1379 profile views
  1. kvk1989

    method for get file

    So this method work over the internet? Or in tcp , ftp required server IP address?
  2. kvk1989

    method for get file

    hi , can someone tell me what's the best method for get file from another pc (legal way) ? see this video i attached here thanks ! have a good day Video_2024-03-26_172705.mp4
  3. kvk1989

    Help for python code

    Hi , can someone help me to convert a python project in to Delphi code? Thanks !
  4. kvk1989

    python to delphi code convert

    unit USBBruteforce; interface uses SysUtils, Classes, CPort, ConfigClass, Logger, StructConversion; // Include your USB communication library here function BruteForce(device: TComPort; const config: TObject; dump_ptr: Integer; dump: Boolean): TBytes; implementation uses Unit4; function ToBytes(Value: Integer; Size: Integer; Endian: Char): TBytes; begin SetLength(Result, Size); if Endian = '<' then for var i := 0 to Size - 1 do Result[i] := Byte((Value shr (i * 8)) and $FF) else for var i := Size - 1 downto 0 do Result[Size - 1 - i] := Byte((Value shr (i * 8)) and $FF); end; function FromBytes(Bytes: TBytes; Endian: Char): Integer; begin var Size := Length(Bytes); Result := 0; if Endian = '<' then for var i := Size - 1 downto 0 do Result := (Result shl 8) or Bytes[i] else for var i := 0 to Size - 1 do Result := (Result shl 8) or Bytes[i]; end; function BruteForce(device: TComPort; const config: TObject; dump_ptr: Integer; dump: Boolean): TBytes; var addr: Integer; linecode: TBytes; brom: TBytes; i, address: Integer; begin addr := TConfig(config).WatchdogAddress + $50; // Replace TYourConfigClass with your actual config class type try device.Timeouts.ReadInterval := 1; except // Handle timeout setting failure end; // Handle interface claiming based on your USB library // Placeholder code: // try // USBLibrary.ClaimInterface(device); // except // raise Exception.Create('Failed to claim interface'); // end; SetLength(linecode, 8); // Placeholder code for obtaining linecode bytes // Replace the following line with actual code to get linecode bytes from the device // Example: linecode := USBLibrary.GetLinecodeBytes(device); if dump then begin try // Placeholder code for sending commands and reading data from the device except // Handle command sending or data reading failure end; for i := 0 to 3 do begin // Placeholder code for sending control transfers end; // Placeholder code for reading data from the device // Replace the following line with actual code to read data from the device // Example: brom := USBLibrary.ReadData(device, dump_ptr, 0x20000); Move(ToBytes($100030, 4, '<')[0], brom[dump_ptr - 1], 4); Result := brom; end else begin try // Placeholder code for sending commands and reading data from the device except // Handle command sending or data reading failure end; for address := dump_ptr to $FFFF do begin // Placeholder code for sending control transfers for i := 0 to 2 do begin // Placeholder code for sending control transfers end; try // Placeholder code for sending commands and reading data from the device // Replace the following line with actual code to read data from the device // Example: brom := USBLibrary.ReadData(device, address - 5, $40); if Length(brom) = $40 then begin Result := ToBytes(address, 2, '<'); Exit; end; except on E: Exception do begin try // Placeholder code for sending commands and reading data from the device except Result := ToBytes(address + 4, 2, '<'); Exit; end; end; end; end; end; end; end. is this right code ? please tell me
  5. kvk1989

    python to delphi code convert

    from src.common import to_bytes, from_bytes import usb import array import struct def bruteforce(device, config, dump_ptr, dump=False): addr = config.watchdog_address + 0x50 # We don't need to wait long, if we succeeded # noinspection PyBroadException try: device.dev.timeout = 1 except Exception: pass udev = device.udev try: # noinspection PyProtectedMember udev._ctx.managed_claim_interface = lambda *args, **kwargs: None except AttributeError as e: raise RuntimeError("libusb is not installed for port {}".format(device.dev.port)) from e linecode = udev.ctrl_transfer(0xA1, 0x21, 0, 0, 7) + array.array('B', [0]) if dump: try: device.cmd_da(0, 0, 1) device.read32(addr) except: pass for i in range(4): udev.ctrl_transfer(0x21, 0x20, 0, 0, linecode + array.array('B', to_bytes(dump_ptr - 6 + (4 - i), 4, '<'))) udev.ctrl_transfer(0x80, 0x6, 0x0200, 0, 9) brom = bytearray(device.cmd_da(0, 0, 0x20000)) brom[dump_ptr - 1:] = b"\x00" + to_bytes(0x100030, 4, '<') + brom[dump_ptr + 4:] return brom else: try: device.cmd_da(0, 0, 1) device.read32(addr) except: pass for address in range(dump_ptr, 0xffff, 4): for i in range(3): udev.ctrl_transfer(0x21, 0x20, 0, 0, linecode + array.array('B', to_bytes(address - 5 + (3 - i), 4, '<'))) udev.ctrl_transfer(0x80, 0x6, 0x0200, 0, 9) try: if(len(device.cmd_da(0, 0, 0x40))) == 0x40: return (True, address) except RuntimeError: try: device.read32(addr) except: return (False, address + 4) except Exception: return (False, address + 4)
  6. kvk1989

    Comport issue

    thanks ! can i upload here full project ?
  7. kvk1989

    Comport issue

    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;
  8. kvk1989

    Comport issue

    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.
  9. kvk1989

    Comport issue

    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.
  10. kvk1989

    Comport issue

    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.
  11. kvk1989

    Comport issue

    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 received_7133230726795917.mp4
  12. kvk1989

    Convert project c# to pascal

    Please take a look here is python project https://github.com/bkerler/edl And here is c project https://github.com/openpst/libopenpst
  13. kvk1989

    Convert project c# to pascal

    My budget is limited but I can invest 100$
  14. kvk1989

    Convert project c# to pascal

    I have a c# and python project can someone help me to convert project in to Delphi? Thanks have a great day
  15. kvk1989

    command get

    hi i want to use this server request with clever suite internet can someone help me ? thanks ! procedure Tmainform.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); AResponseInfo.ContentType := ' '; if trim(ARequestInfo.URI).Contains(' ') then begin AResponseInfo.ContentText :=' ';
×