Jump to content

kvk1989

Members
  • Content Count

    71
  • Joined

  • Last visited

Everything posted by kvk1989

  1. 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
  2. kvk1989

    method for get file

    So this method work over the internet? Or in tcp , ftp required server IP address?
  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

    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)
  5. 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
  6. 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
  7. kvk1989

    Comport issue

    thanks ! can i upload here full project ?
  8. 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;
  9. 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.
  10. 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.
  11. 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.
  12. 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
  13. 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
  14. kvk1989

    Convert project c# to pascal

    My budget is limited but I can invest 100$
  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 :=' ';
  16. kvk1989

    Encryption

    Hi can someone please tell me which encryption is that thanks ! SxRDQVNER0ATCERBRFEYFlpRQ0VRUlcSCBEACwkAExgWcFZAURQKF310awBgZ3lHf2F6c3lfeUJ9cGtJfWdSRmJnWXdmXnIJEhoSdFVVXEcTCBJQXA1eVQVMWFRdZ1pSX2FIaGhXcG4GBV9VZ0FFbAAJRhEdEGJAUBYOFmVjAUJpYWsCfFl8SH1JYAR6cXYJEhoSYVtdVxELEH1ZcE15TQdDfmUAQnxXDw4THhJnXl9RWhUOEntadEt9WwNGfGMDRnpddU55WllHeEhfA31GDw0RHRZnXFYFEgwSe1hXAHx1aHJ9W1MGZWNtR3hbcAB+dmoFfXV+A2VgbQN6WlEEZEhpBnx0fwJ8dVMGel1tAnh0bAB+WHIDfFpqSHpebQR5VwsNF08=
  17. kvk1989

    C to Pascal

    Hello all ! Can someone help me to port code c to Pascal? Don't worry i will pay for it Thanks have a great day 🙂
  18. kvk1989

    C to Pascal

    I will try with chatgpt !
  19. kvk1989

    C to Pascal

    Ok thanks 👍
  20. kvk1989

    C to Pascal

    I need whole project
  21. kvk1989

    C to Pascal

    https://github.com/andersson/qdl
  22. kvk1989

    Write process memory

    procedure TLoaderEngine.ResumePThread; begin ResumeThread(hThread); bProcessSuspended := False; end; { This function Exit the remote process } procedure TLoaderEngine.TerminateRemoteProcess; begin TerminateProcess(hProcess, 0); end; { This function return the state of proces. If suspended it will return true } function TLoaderEngine.CheckIfSuspended : Boolean; begin Result := bProcessSuspended; end; { This function returns the VA (Virtual Address) of desired dll or main process if you wanna find pattern in main process itself you have to put main exe name in ModuleName parameter, else you can put the name of dll } function TLoaderEngine.FindBytesPattern(ModuleName : string; Pattern: array of Byte; Mask: array of Byte; Hits : Integer): DWORD; var PELocation : DWORD; NoOfSections, PESign : Word; SectionHeader : IMAGE_SECTION_HEADER; BaseAddress, SectionStartAddress : DWORD; i, j, k, cnt: Integer; SectionDataBuffer : array of Byte; begin PELocation := 0; NoOfSections := 0; PESign := 0; cnt := 0; Result := 0; ZeroMemory(@SectionHeader, SizeOf(SectionHeader)); BaseAddress := GetRemoteDLLBase(ModuleName); ReadMemory(BaseAddress, PESign, 2); if PESign = $5A4D then begin ReadMemory(BaseAddress + $3C, PELocation, 4); ReadMemory(BaseAddress + PELocation, PESign, 2); if PESign = $4550 then begin ReadMemory(BaseAddress + PELocation + 6, NoOfSections, 2); if NoOfSections > 0 then begin SectionStartAddress := BaseAddress + PELocation + $F8; for i := 1 to NoOfSections do begin Result := 0; j := 0; { Read section header } ReadMemory(SectionStartAddress, SectionHeader, SizeOf(SectionHeader)); { Set Length of array and read data from process } SetLength(SectionDataBuffer, SectionHeader.Misc.VirtualSize); ReadMemory(SectionHeader.VirtualAddress + BaseAddress, SectionDataBuffer[0], SectionHeader.Misc.VirtualSize); { Let's process that data } for k := 0 to (SectionHeader.Misc.VirtualSize - Length(Pattern)) -1 do begin if (SectionDataBuffer[k] = Pattern[j]) or (Mask[j] = 1) then begin Inc(j); if Length(Pattern) = j then begin Inc(cnt); { Check if we found it } if Hits = cnt then begin Result := SectionHeader.VirtualAddress + (k - (Length(Pattern) - 1)) + BaseAddress; Break; end; end; end else j := 0; end; if Result <> 0 then Break; { Process next section } SectionStartAddress := SectionStartAddress + SizeOf(IMAGE_SECTION_HEADER); end; end else Result := 0; end else Result := 0; end else Result := 0; end; { This function return handle of process } function TLoaderEngine.GetProcessHandle : THandle; begin Result := hProcess; end; { This function return handle of thread } function TLoaderEngine.GetThreadHandle: THandle; begin Result := hThread; end; { This function will stop the program here until it finds a newly created window of Target or until it hits the timeout. } function TLoaderEngine.WaitTillFirstWindow(Timeout: Integer) : Boolean; var TimeoutCounter : Integer; begin TimeoutCounter := 0; bEnumWindow := False; { Loop for checking EnumWindows } while not bEnumWindow do begin EnumWindows(@EnumWindowsProc, 0); Inc(TimeoutCounter); if TimeoutCounter div 100 = Timeout then begin Break; end; end; Result := bEnumWindow; end; { This function return the base address of loaded dll in Remote process. If function fails returns 0 } function TLoaderEngine.GetRemoteDLLBase(DLLName : string) : DWORD; var cbNeeded, DLLPathSize : DWORD; DLLPath : string; hModP : PHMODULE; hMods : array of HMODULE; Filename : array[0..MAX_PATH-1] of Char; i : Integer; begin EnumProcessModules(hProcess, nil, 0, cbNeeded); Result := 0; if cbNeeded <= 0 then Exit; //Alloc memory for storing hMods SetLength(hMods, cbNeeded div sizeof(HMODULE)); ZeroMemory(@hMods[0], SizeOf(hMods)); hModP := @hMods[0]; if EnumProcessModules(hProcess, hModP, cbNeeded, cbNeeded) then begin for i := 0 to Length(hMods)-1 do begin ZeroMemory(@Filename[0], Length(Filename)*2); DLLPathSize := Length(Filename); if GetMappedFileName(hProcess, Pointer(hMods[i]), @Filename[0],DLLPathSize) > 0 then begin //do nothing end else begin // just another trick to retrive dll path GetModuleFileNameEx(hProcess, hMods[i], @Filename[0], DLLPathSize); end; //make both text in lowercase just for case sensitive //if DLLname found in DLLpath break the loop and return Base of DLL DLLPath := LowerCase(Filename); DLLName := LowerCase(DLLName); if Pos(DLLName, DLLPath) > 0 then begin Result := hMods[i]; Break; end; end; end else Result := 0; end; { This function alloct memory in remote process, if this function fail it will return nil as result } function TLoaderEngine.AllocMemory(Size: NativeUInt) : Pointer; begin Result := VirtualAllocEx(hProcess, nil, Size, MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE); end; { This function free memory in which is alloct by AllocMemory } function TLoaderEngine.DeAllocMemory(Memory: Pointer) : Boolean; begin if VirtualFreeEx(hProcess, Memory, 0, MEM_RELEASE) then Result := True else Result := false; end; { Destructor of TLoaderEngine class } destructor TLoaderEngine.Destroy; begin inherited; CloseHandle(hProcess); CloseHandle(hThread); end; end. Hi can someone help me to make it on gui thanks ! Here is link of. This code https://github.com/GautamGreat/LoaderEngine
  23. kvk1989

    Write process memory

    Hi I attach a github link (loader engine) unit Loader_Engine; I just want to add these code on external gui program ! Thanks !
  24. kvk1989

    write console code

    hi can someone help me to write this code thanks ! Usage : odin4 [args...] Odin4 downloader. odin4 version 1.2.13 -v SHOW VERSION -w Show License -b Add Bootloader file -a Add AP image file -c Add CP image file -s Add CSC file -u Add UMS file -e Set Nand erase option -V Home binary validation check with pit file --reboot Reboot into normal mode --noreboot Don't reboot after flashing binaries --redownload Reboot into download mode if it possible (not working in normal case) --ignore-md5 Ignore MD5SUM. odin don't verify the integrity of files --md5sum-only Verify the integrity of files(xxx.tar.MD5). odin don't flash binary -d Set a device path (detect automatically without this option) -l Show downloadable devices path --list Show downloadable devices path and usb location (linux/win) --verbose Verbose. (Single download only) IMPORTANT : You must set up your system to detect your device on LINUX host. create this file: /etc/udev/rules.d/51-android.rules to add a line to the file: SUBSYSTEM=="usb", ATTR{idVendor}=="04e8", MODE="0666", GROUP="plugdev" (http://developer.android.com/tools/device.html) And you maybe need to unload a module cdc_acm before downloading. (This is only needed for older kernels.) $sudo rmmod cdc_acm OR echo "blacklist cdc_acm" > /etc/modprobe.d/cdc_acm-blacklist.conf Example : $odin4 -b BL_XXXX.tar.md5 -a AP_XXXX.tar.md5 -c CP_XXXX.tar.md5 -s CSC_XXXX.tar.md5 Example (Select One Device): $odin4 -l PATH_OF_DEVICE_A PATH_OF_DEVICE_B $odin4 -b BL_XXXX.tar.md5 -a AP_XXXX.tar.md5 -c CP_XXXX.tar.md5 -s CSC_XXXX.tar.md5 -d PATH_OF_DEVICE_A Odin Community : http://mobilerndhub.sec.samsung.net/hub/site/odin/ i write like this but not working var Strm: TMemoAppendStream; begin Strm := TMemoAppendStream.Create(Memo1); try GetDosOutput(Strm, 'd.exe -b '+e1.Text+'d.exe -a '+e2.Text+'d.exe -c'+e3.Text+'d.exe -s'+e4.Text+'-d PATH_OF_DEVICE_A', ExtractFilePath(application.ExeName) + 'bin\'); finally Strm.Free; end; end; end;
  25. kvk1989

    write console code

    When I execute codes it's showing " d.exe failed parse" See this video how cmd console works
×