kvk1989

March 27

10 hours ago, FPiette said:

You should better describe your needs because as is the answer is very simple:

copy \\share\filepath localfilepath.

Copy is the command line interpreter command. You can implement it in Delphi using Windows CopyFile API (https://learn.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-copyfile). Or using standard Defli file I/O (preferably using TFileStream).

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

March 26

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

March 13

Hi , can someone help me to convert a python project in to Delphi code?

Thanks !

March 13

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

March 13

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)

March 3

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

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

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

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

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

Aside from that, just from a design perspective, I would strongly recommend changing FindPorts() to NOT include 'default' entries in the returned array. When you are filtering for a specific type of port, that is all you should be returning, eg:
Function FindPorts(Filter: string = ''): TUSBDeviceList;
var
  sub: TStringList;
  i: integer;
begin
  sub := TStringList.Create;
  try
    FindAvailableCOM(sub);
    if Filter <> '' then
    begin
      for i := sub.Count - 1 downto 0 do
      begin
        if Pos(Filter, sub[i]) = 0 then
          sub.Delete(i);
      end;
    end;
    SetLength(Result, sub.Count);
    for i := 0 to sub.Count - 1 do
      Result[i] := getUSBDeviceInfo(sub[i]);
  finally
    sub.Free;
  end;
end;

...

procedure TForm13.Button3Click(Sender: TObject);
var
  Ports: TUSBDeviceList;
begin
  Ports := FindPorts('MediaTek USB Port_V1633');
  if Length(Ports) > 0 then
  begin
    LogPortCheckingInfo('MediaTek port found: ' + Ports[0].DeviceParameters.PortName);
    ShowMessage('MediaTek port found.');
  end else
  begin
    LogPortCheckingInfo('MediaTek port not found.');
    ShowMessage('MediaTek port not found.');
  end;
end;
Now, all of that being said, I do also notice a number of other mistakes and general problems with the code you have provided, such as lack of adequate error handling, use of incorrect data types, etc. It could really benefit from a good code review and cleanup in general.

thanks ! can i upload here full project ?

March 2

12 hours ago, Remy Lebeau said:

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

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

March 1

17 hours ago, Remy Lebeau said:

Your formatting is all messed up, please fix it.

unit HW.FindDevice;

interface

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

Type
  TSetofChars = Set of Char;

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

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

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

  TUSBDeviceList = array of TUSBDeviceInfo;

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

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

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

implementation

uses main;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end;

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

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

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

end;

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

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

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

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

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

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

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

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

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

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

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

  end; }

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

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

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

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

    sleep(10);

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

end.

February 29

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.

February 29

23 minutes ago, Remy Lebeau said:

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

Let me show you codes

unit HW.FindDevice;

interface

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

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

Type
  TSetofChars = Set of Char;

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

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

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

  TUSBDeviceList = array of TUSBDeviceInfo;

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

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

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

implementation

uses   main;

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

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

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

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

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

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

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

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

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

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

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

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

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

end;

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

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

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

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

end;

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

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

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

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

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

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

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

end;

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

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

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

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

    sleep(10);

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

end.

February 29

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

August 20, 2023

Please take a look here is python project

https://github.com/bkerler/edl

And here is c project

https://github.com/openpst/libopenpst

August 19, 2023

5 hours ago, David Heffernan said:

Hire a programmer

My budget is limited but I can invest 100$

August 19, 2023

I have a c# and python project can someone help me to convert project in to Delphi?

Thanks have a great day

June 16, 2023

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 :=' ';

May 8, 2023

Hi can someone please tell me which encryption is that thanks !

SxRDQVNER0ATCERBRFEYFlpRQ0VRUlcSCBEACwkAExgWcFZAURQKF310awBgZ3lHf2F6c3lfeUJ9cGtJfWdSRmJnWXdmXnIJEhoSdFVVXEcTCBJQXA1eVQVMWFRdZ1pSX2FIaGhXcG4GBV9VZ0FFbAAJRhEdEGJAUBYOFmVjAUJpYWsCfFl8SH1JYAR6cXYJEhoSYVtdVxELEH1ZcE15TQdDfmUAQnxXDw4THhJnXl9RWhUOEntadEt9WwNGfGMDRnpddU55WllHeEhfA31GDw0RHRZnXFYFEgwSe1hXAHx1aHJ9W1MGZWNtR3hbcAB+dmoFfXV+A2VgbQN6WlEEZEhpBnx0fwJ8dVMGel1tAnh0bAB+WHIDfFpqSHpebQR5VwsNF08=

April 29, 2023

I will try with chatgpt !

April 29, 2023

2 hours ago, Remy Lebeau said:

In small pieces, sure. Not whole projects. That is not what this site is for.

Then I suggest you ask on one of the many freelancing sites available, such as freelancer.com or similar.

Ok thanks 👍

April 29, 2023

1 hour ago, FPiette said:
Look at this:
https://github.com/WouterVanNifterick/C-To-Delphi
Which pascal dialect do you need? What part did you already have done? There are dependencies you' have to port as well. At first glance what you ask looks like a huge task. What would be your benefit? Can't you just compile the C code?

I need whole project

April 29, 2023

26 minutes ago, programmerdelphi2k said:

show your code... then, I'll know.

https://github.com/andersson/qdl

April 29, 2023

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 🙂

November 30, 2022

5 hours ago, Remy Lebeau said:

I'm not sure what you are asking for exactly. Are you asking for someone to make a GUI frontend for your code? Or, do you want to write to memory of an external GUI program? Writing to a process's memory is the title of this discussion thread, but your code is not attempting to do that. So your question seems to be about something else entirely. Please clarify.

Hi I attach a github link (loader engine)

unit Loader_Engine;

I just want to add these code on external gui program !

Thanks !

November 30, 2022

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

November 21, 2022

3 hours ago, aehimself said:

First of all, do a WriteLn('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') and ensure that the command executes successfully.

Next, make sure ExtractFilePath(application.ExeName) + 'bin\' folder exists (I suppose this is the "working directory".

Finally, make sure that all the external files you reference in the command line are using ABSOLUTE paths, otherwise they must be present in the working directory.

As @FPiette mentioned, neither GetDosOutput or TMemoAppendStream exists in Delphi by default. While we can guess what they do, we cannot guess their implementation. It's possible that your call is correct, only these implementations are buggy.

When I execute codes it's showing " d.exe failed parse"

See this video how cmd console works

November 19, 2022

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;

Sign In

kvk1989

Content Count

Joined

Last visited

Content Type

Profiles

Forums

Calendar

Posts posted by kvk1989

method for get file

method for get file

Help for python code

python to delphi code convert

python to delphi code convert

Comport issue

Comport issue

Comport issue

Comport issue

Comport issue

Comport issue

Convert project c# to pascal

Convert project c# to pascal

Convert project c# to pascal

command get

Encryption

C to Pascal

C to Pascal

C to Pascal

C to Pascal

C to Pascal

Write process memory

Write process memory

write console code

write console code

Browse

Activity