Function USBOpenDriver:boolean; 
  begin 
    // Open Device Path  \\?\USB#Vid_058b&Pid_0015#5&25ea51ff&0&1#{a5dcbf10-6530-11d2-901f-00c04fb951ed} 
  USBPORT:= '\??\USB#Vid_0c47&Pid_4000#802001789#{a5dcbf10-6530-11d2-901f-00c04fb951ed}' ; 
  {  CreateFile('\\?\USB1', GENERIC_WRITE or GENERIC_READ, 
    FILE_SHARE_WRITE or FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED OR FILE_ATTRIBUTE_NORMAL, 0); 
    USBOpenDriver:= USBPORT <> INVALID_HANDLE_VALUE; } 
    if USBPORT = INVALID_HANDLE_VALUE then // error at open port 
      begin 
        result:=false; 
      end else result:=true; 
  end;

unit USB; 
   
  interface 
  Uses SysUtils, Forms, Windows; 
   
  {******************************************************************************} 
  {*                       USB - Read / Write Unit                              *} 
  {*                          by Harald Kubovy                                  *} 
  {*                                                                            *} 
  {*  How To USE:                                                               *} 
  {*  Sending and Reading Data to Device:                                       *} 
  {*  string_result:= RWUSB('DATA TO SEND IN HEX', Read, Timeout);              *} 
  {*                                                                            *} 
  {*  EXAMPLE (ONLY SENDING):                                                   *} 
  {*  s:= RWUSB('FF FF FF');                                                    *} 
  {*                                                                            *} 
  {*  s is String Result of Readed Data from Device                             *} 
  {*  'FF FF FF' is Data to Send in Hex  (this will send FFFFFF to Device       *} 
  {*                                                                            *} 
  {*                                                                            *} 
  {*  EXAMPLE WITH READING AFTER WRITING:                                       *} 
  {*  s:= RWUSB('FFFF', 16);                                                    *} 
  {*                                                                            *} 
  (*  16 = How mutch to Read / 0 for no Reading                                 *) 
  {*                                                                            *} 
  {*  EXAMPLE WITH TIMEOUT:                                                     *} 
  {*  s:= RWUSB('FFFF', 16, 100);                                               *} 
  {*                                                                            *} 
  {*  100 is the Reading Timeout, Standart is 500/ms.                           *} 
  {*                                                                            *} 
  {*                                                                            *} 
  {* Copyright - Do whatever you whant with it  ;o)                             *} 
  {******************************************************************************} 
   
   
   
  type 
  TSetofChars = Set of Char; 
   
    Function USBOpenDriver:boolean; 
    Function USBCloseDriver:boolean; 
    function USBReadText(BytesRead: cardinal; timeout: cardinal = 500): string; 
    function USBReadHEX(BytesRead: cardinal; timeout: cardinal = 500): string; 
    function RWUSB(frame: string; readLen:integer = 0; ReadTimeout: integer = 500; Typ : String = 'HEX') : string; 
    procedure USBWriteHEX(frame: string); 
   
  implementation 
   
   
  { Get Handle of DeviceDriver } 
  var USBPORT:Thandle = INVALID_HANDLE_VALUE; 
   
  {$HINTS OFF} 
  { Open USB Driver } 
  Function USBOpenDriver:boolean; 
  begin 
    // Open Device Path  \\?\USB#Vid_058b&Pid_0015#5&25ea51ff&0&1#{a5dcbf10-6530-11d2-901f-00c04fb951ed} 
  USBPORT:= '\??\USB#Vid_0c47&Pid_4000#802001789#{a5dcbf10-6530-11d2-901f-00c04fb951ed}' ; 
  {  CreateFile('\\?\USB1', GENERIC_WRITE or GENERIC_READ, 
    FILE_SHARE_WRITE or FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED OR FILE_ATTRIBUTE_NORMAL, 0); 
    USBOpenDriver:= USBPORT <> INVALID_HANDLE_VALUE; } 
    if USBPORT = INVALID_HANDLE_VALUE then // error at open port 
      begin 
        result:=false; 
      end else result:=true; 
  end; 
  {$HINTS ON} 
   
   
  Function USBCloseDriver:boolean; 
  begin 
    USBCloseDriver := CloseHandle(USBPORT); 
    USBPORT := INVALID_HANDLE_VALUE; 
  end; 
   
   
  function NurBestimmteZeichen (const aValue : String; aChars : TSetofChars) : String; 
  var 
    i: Integer; 
    newString : string; 
  begin 
    newString := ''; 
    for i := 0 to Length(aValue) do 
    begin 
      if aValue[i] in aChars then 
      begin 
        newString := newString + aValue[i]; 
      end; 
    end; 
    result := newString; 
  end; 
   
   
   
  Function HexToStr(s: String): String; 
  Var 
  i : Integer; 
  Begin 
    Result:=''; i:=1; 
    While i<Length(s) Do 
    Begin 
      Result:=Result+Chr(StrToIntDef('$'+Copy(s,i,2),0)); 
      Inc(i,2); 
    End; 
  End; 
   
   
  Function StrToHex(s: String): String; 
  Var 
    i : Integer; 
  Begin 
    Result:=''; 
    If Length(s)>0 Then 
      For i:=1 To Length(s) Do Result:=Result+IntToHex(Ord(s[i]),2); 
  End; 
   
   
   
  Function USBReadTEXT(BytesRead : dWord; timeout: cardinal = 500) : string; 
  var 
    d: array[0..10000] of byte; {Readed Data} 
    s, buffer: string; 
    i, Tmp: Integer; 
    Ovr : TOverlapped; 
    count :cardinal; {Count = How mutch Readed Bytes} 
  begin 
    Result := ''; 
    count:=0; 
    Fillchar( d, sizeof(d), 0 ); 
    FillChar(Ovr, SizeOf(TOverlapped), 0); 
    Ovr.hEvent := CreateEvent(nil, true, FALSE, nil); 
    if not ReadFile(USBPORT, d, BytesRead, count, @ovr) then 
      if GetLastError=Error_IO_Pending then 
        if WaitForSingleObject(ovr.hEvent, timeout) = WAIT_OBJECT_0 then 
          GetOverlappedResult(USBPORT, ovr, count, false) 
    else CancelIo(USBPORT); 
    CloseHandle(Ovr.hEvent); 
    s := ''; 
    for i := 0 to count-1 do 
    begin 
      Tmp:=ord(d[i]); 
      s := s + Char(Tmp); 
    end; 
    {Convert to String Text} 
    s := strtohex(s); 
    buffer:=''; 
    for i:=1 to length(s) do 
    begin 
      if Odd(i) then 
      begin 
        buffer := ''; 
        buffer := hextostr(s[i] + s[i+1]); 
        buffer := NurBestimmteZeichen(buffer,['0'..'9','a'..'z','A'..'Z','.'..':',' '..'?']); 
        result := result+buffer; 
      end; 
    end; 
  end; 
   
   
   
  Function USBReadHEX(BytesRead : dWord; timeout: cardinal = 500) : string; 
  var 
    d: array[0..10000] of byte; {Readed Data} 
    s: string; 
    i, Tmp: Integer; 
    Ovr : TOverlapped; 
    count :cardinal; {Count = How mutch Readed Bytes} 
  begin 
    Result := ''; 
    count:=0; 
    Fillchar( d, sizeof(d), 0 ); 
    FillChar(Ovr, SizeOf(TOverlapped), 0); 
    Ovr.hEvent := CreateEvent(nil, true, FALSE, nil); 
    if not ReadFile(USBPORT, d, BytesRead, count, @ovr) then 
      if GetLastError=Error_IO_Pending then 
        if WaitForSingleObject(ovr.hEvent, timeout) = WAIT_OBJECT_0 then 
          GetOverlappedResult(USBPORT, ovr, count, false) 
    else CancelIo(USBPORT); 
    CloseHandle(Ovr.hEvent); 
    s := ''; 
    for i := 0 to count-1 do 
    begin 
      Tmp:=ord(d[i]); 
      s := s + Char(Tmp); 
    end; 
    Result := strtohex(s); 
  end; 
   
   
   
  Function _USBWritePointerA(bp : Pointer; SizeToSend : DWord; timeout: integer) : Cardinal; 
  var 
    Ovr : TOverlapped; 
  begin 
      Result := 0; 
      FillChar(Ovr, SizeOf(TOverlapped), 0); 
      Ovr.hEvent := CreateEvent(nil, true, FALSE, nil); 
      if not WriteFile(USBPort, bp^, SizeToSend, Result, @ovr) then 
          if GetLastError=Error_IO_Pending then 
              if WaitForSingleObject(ovr.hEvent, timeout) = WAIT_OBJECT_0 then 
                  GetOverlappedResult(USBPORT, ovr, Result, false) 
              else CancelIo(USBPORT); 
      CloseHandle(Ovr.hEvent); 
  end; 
   
   
   
  procedure USBWriteHEX(frame: string); 
  var 
    BytesWritten: DWord; 
  begin 
    while Pos(' ', FRAME) > 0 do Delete(FRAME,Pos(' ', FRAME),1); 
    frame:=hextostr(frame); 
    WriteFile(USBPORT, (Pchar(frame))^, SizeOf(frame), BytesWritten, nil); 
  end; 
   
   
   
   
  Function USBWritePointerA(bp : Pointer; SizeToSend : DWord) : boolean; 
  begin 
    Result := _USBWritePointerA(bp, SizeToSend, $688) = SizeToSend; 
  end; 
   
   
   
  Function USBWriteStringA(SendString : String) : boolean; 
  var 
    StrSize : Word; 
  begin 
    StrSize := Length(SendString); 
    Result := _USBWritePointerA(@SendString[1], StrSize, $688) = StrSize; 
  end; 
   
   
  function RWUSB(frame: string; readLen:integer = 0; ReadTimeout: integer = 500; Typ : String = 'HEX') : string; 
  begin 
    while Pos(' ', FRAME) > 0 do Delete(FRAME,Pos(' ', FRAME),1); 
    if length(frame) >0 then USBWriteStringA(hextostr(frame)); 
    Application.ProcessMessages; 
    sleep(ReadTimeout); 
    if (ReadLen >0) and (Typ='HEX')    then result:=USBReadHEX(readLen, ReadTimeout); 
    if (ReadLen >0) and (Typ='STRING') then result:=USBReadText(readLen, ReadTimeout); 
  end; 
   
   
  end.