1:
2:
3:
4:
5:

 if ReadFile(USBPORT, d, sizeof(d), BytesRead, nil) = false then
    begin
       ADDLine('[ERROR] - Unable to read from USB!');
     exit;
    end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

Function _USBReadPointerA(bp : pointer; SizeToRead : dWord; timeout: cardinal) : Cardinal;
var
    Ovr : TOverlapped;
begin
    Result := 0;
    FillChar(Ovr, SizeOf(TOverlapped), 0);
    Ovr.hEvent := CreateEvent(nil, true, FALSE, nil);
    if not ReadFile(USBPORT, bp^, SizeToRead, 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;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:

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:= 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.