Kullandığım unitler.
Mahusb.pas
Kod: Tümünü seç
unit MahUSB;
interface
uses
Windows,
Messages,
SysUtils,
Classes,
Registry,
Masks;
type
{ Event Types }
TOnDevVolumeEvent = procedure(const bInserted : boolean;
const sDrive : string) of object;
TOnUsbChangeEvent = procedure(const bInserted : boolean;
const ADevType,ADriverName,
AFriendlyName : string) of object;
{ USB Class }
TUsbClass = class(TObject)
private
FHandle : HWND;
FOnUsbChangeEvent : TOnUsbChangeEvent;
FOnDevVolumeEvent : TOnDevVolumeEvent;
procedure GetUsbInfo(const ADeviceString : string;
out ADevType,ADriverDesc,
AFriendlyName : string);
function DriverLetter(const aUM:Cardinal) : string;
procedure WinMethod(var AMessage : TMessage);
procedure RegisterUsbHandler;
procedure WMDeviceChange(var AMessage : TMessage);
public
constructor Create;
destructor Destroy; override;
property OnUsbChange : TOnUsbChangeEvent read FOnUsbChangeEvent
write FOnUsbChangeEvent;
property OnDevVolume : TOnDevVolumeEvent read FOnDevVolumeEvent
write FOnDevVolumeEvent;
end;
// -----------------------------------------------------------------------------
implementation
type
// Win API Definitions
PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;
DEV_BROADCAST_DEVICEINTERFACE = record
dbcc_size : DWORD;
dbcc_devicetype : DWORD;
dbcc_reserved : DWORD;
dbcc_classguid : TGUID;
dbcc_name : char;
end;
PDEV_BROADCAST_VOLUME = ^DEV_BROADCAST_VOLUME;
DEV_BROADCAST_VOLUME = record
dbcv_size : DWORD;
dbcv_devicetype : DWORD;
dbcv_reserved : DWORD;
dbcv_unitmask : DWORD;
dbcv_flags : WORD;
end;
{
dbcv_flags ->
DBTF_MEDIA 0x0001
Change affects media in drive. If not set, change affects physical device or drive.
DBTF_NET 0x0002
Indicated logical volume is a network volume.
}
const
{
http://msdn.microsoft.com/en-us/library/aa363431%28VS.85%29.aspx
RegisterDeviceNotification
http://msdn.microsoft.com/en-us/library/aa363246%28VS.85%29.aspx
DBT_DEVTYP_DEVICEINTERFACE 0x00000005
Class of devices. This structure is a DEV_BROADCAST_DEVICEINTERFACE structure.
DBT_DEVTYP_HANDLE 0x00000006
File system handle. This structure is a DEV_BROADCAST_HANDLE structure.
DBT_DEVTYP_OEM 0x00000000
OEM- or IHV-defined device type. This structure is a DEV_BROADCAST_OEM structure.
DBT_DEVTYP_PORT 0x00000003
Port device (serial or parallel). This structure is a DEV_BROADCAST_PORT structure.
DBT_DEVTYP_VOLUME 0x00000002
Logical volume. This structure is a DEV_BROADCAST_VOLUME structure.
}
// Miscellaneous
GUID_DEVINTF_USB_DEVICE : TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
USB_VOLUME = $00000002; // Device interface class
USB_INTERFACE = $00000005; // Device interface class
USB_INSERTION = $8000; // System detected a new device
USB_REMOVAL = $8004; // Device is gone
DBTF_MEDIA = $0001;
DBTF_NET = $0002;
// Registry Keys
USBKEY = 'SYSTEM\CurrentControlSet\Enum\USB\%s\%s';
USBSTORKEY = 'SYSTEM\CurrentControlSet\Enum\USBSTOR';
SUBKEY1 = USBSTORKEY + '\%s';
SUBKEY2 = SUBKEY1 + '\%s';
constructor TUsbClass.Create;
begin
inherited Create;
FHandle := AllocateHWnd(WinMethod);
RegisterUsbHandler;
end;
destructor TUsbClass.Destroy;
begin
DeallocateHWnd(FHandle);
inherited Destroy;
end;
procedure TUsbClass.GetUsbInfo(const ADeviceString : string;
out ADevType,ADriverDesc,
AFriendlyName : string);
var sWork,sKey1,sKey2 : string;
oKeys,oSubKeys : TStringList;
oReg : TRegistry;
i,ii : integer;
bFound : boolean;
begin
ADevType := '';
ADriverDesc := '';
AFriendlyName := '';
if ADeviceString <> '' then begin
bFound := false;
oReg := TRegistry.Create;
oReg.RootKey := HKEY_LOCAL_MACHINE;
// Extract the portions of the string we need for registry. eg.
// \\?\USB#Vid_4146&Pid_d2b5#0005050400044#{a5dcbf10- ..... -54334fb951ed}
// We need sKey1='Vid_4146&Pid_d2b5' and sKey2='0005050400044'
sWork := copy(ADeviceString,pos('#',ADeviceString) + 1,1026);
sKey1 := copy(sWork,1,pos('#',sWork) - 1);
sWork := copy(sWork,pos('#',sWork) + 1,1026);
sKey2 := copy(sWork,1,pos('#',sWork) - 1);
// Get the Device type description from \USB key
if oReg.OpenKeyReadOnly(Format(USBKEY,[skey1,sKey2])) then begin
ADevType := oReg.ReadString('DeviceDesc');
oReg.CloseKey;
oKeys := TStringList.Create;
oSubKeys := TStringList.Create;
// Get list of keys in \USBSTOR and enumerate each key
// for a key that matches our sKey2='0005050400044'
// NOTE : The entry we are looking for normally has '&0'
// appended to it eg. '0005050400044&0'
if oReg.OpenKeyReadOnly(USBSTORKEY) then begin
oReg.GetKeyNames(oKeys);
oReg.CloseKey;
// Iterate through list to find our sKey2
for i := 0 to oKeys.Count - 1 do begin
if oReg.OpenKeyReadOnly(Format(SUBKEY1,[oKeys[i]])) then begin
oReg.GetKeyNames(oSubKeys);
oReg.CloseKey;
for ii := 0 to oSubKeys.Count - 1 do begin
if MatchesMask(oSubKeys[ii],sKey2 + '*') then begin
// Got a match?, get the actual desc and friendly name
if oReg.OpenKeyReadOnly(Format(SUBKEY2,[oKeys[i],
oSubKeys[ii]])) then begin
ADriverDesc := oReg.ReadString('DeviceDesc');
AFriendlyName := oReg.ReadString('FriendlyName');
oReg.CloseKey;
end;
bFound := true;
end;
end;
end;
if bFound then break;
end;
end;
FreeAndNil(oKeys);
FreeAndNil(oSubKeys);
end;
FreeAndNil(oReg);
end;
end;
procedure TUsbClass.WMDeviceChange(var AMessage : TMessage);
var iDevType : integer;
sDevString,sDevType,
sDriverName,sFriendlyName : string;
pData : PDevBroadcastDeviceInterface;
pVol : PDEV_BROADCAST_VOLUME;
begin
if (AMessage.wParam = USB_INSERTION) or
(AMessage.wParam = USB_REMOVAL) then begin
pData := PDevBroadcastDeviceInterface(AMessage.LParam);
iDevType := pData^.dbcc_devicetype;
if iDevType = USB_VOLUME then
if Assigned(FOnDevVolumeEvent) then begin
pVol := PDEV_BROADCAST_VOLUME(AMessage.LParam);
FOnDevVolumeEvent((AMessage.wParam = USB_INSERTION),
DriverLetter(pVol.dbcv_unitmask));
end
else
else
// Is it a USB Interface Device ?
if iDevType = USB_INTERFACE then begin
sDevString := PChar(@pData^.dbcc_name);
GetUsbInfo(sDevString,sDevType,sDriverName,sFriendlyName);
// Trigger Events if assigned
if Assigned(FOnUsbChangeEvent) then
FOnUsbChangeEvent((AMessage.wParam = USB_INSERTION),
sDevType,sDriverName,sFriendlyName);
end;
end;
end;
procedure TUsbClass.WinMethod(var AMessage : TMessage);
begin
if (AMessage.Msg = WM_DEVICECHANGE) then
WMDeviceChange(AMessage)
else
AMessage.Result := DefWindowProc(FHandle,AMessage.Msg,
AMessage.wParam,AMessage.lParam);
end;
procedure TUsbClass.RegisterUsbHandler;
var rDbi : DEV_BROADCAST_DEVICEINTERFACE;
iSize : integer;
begin
iSize := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
ZeroMemory(@rDbi,iSize);
rDbi.dbcc_size := iSize;
rDbi.dbcc_devicetype := USB_INTERFACE;
rDbi.dbcc_reserved := 0;
rDbi.dbcc_classguid := GUID_DEVINTF_USB_DEVICE;
rDbi.dbcc_name := #0;
RegisterDeviceNotification(FHandle,@rDbi,DEVICE_NOTIFY_WINDOW_HANDLE);
end;
function TUsbClass.DriverLetter(const aUM: Cardinal): string;
begin
case aUM of
1: result := 'A:';
2: result := 'B:';
4: result := 'C:';
8: result := 'D:';
16: result := 'E:';
32: result := 'F:';
64: result := 'G:';
128: result := 'H:';
256: result := 'I:';
512: result := 'J:';
1024: result := 'K:';
2048: result := 'L:';
4096: result := 'M:';
8192: result := 'N:';
16384: result := 'O:';
32768: result := 'P:';
65536: result := 'Q:';
131072: result := 'R:';
262144: result := 'S:';
524288: result := 'T:';
1048576: result := 'U:';
2097152: result := 'V:';
4194304: result := 'W:';
8388608: result := 'X:';
16777216: result := 'Y:';
33554432: result := 'Z:';
end;
end;
end.
Usbdetect.pas
Kod: Tümünü seç
unit USBDetect;
////////////////////////////////////////////////////
/// ///
/// USB Detector component Ver 2.0.0.0 ///
/// ///
/// Written by Mojtaba Tajik ( Silversoft ) ///
/// Released on 10/13/2010 ///
/// E-Mail : Tajik1991@gmail.com ///
/// ///
////////////////////////////////////////////////////
interface
uses
Windows, Forms, SysUtils, Classes, Messages, dialogs;
type
TUSBEvent= Procedure (Sender: TObject; Drive: String) of Object;
type
TUSBDetector = class(TComponent)
private
{ Private declarations }
FWindowHandle: HWND;
FArrival, FRemoved: TUSBEvent;
procedure WndProc(var Msg: TMessage);
protected
{ Protected declarations }
procedure WMDEVICECHANGE(Var Msg: TMessage); Message WM_DEVICECHANGE;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
Property OnArrival: TUSBEvent read FArrival write FArrival;
Property OnRemoved: TUSBEvent read FRemoved write FRemoved;
end;
procedure Register;
// Device constants
const
DBT_DEVICEARRIVAL = $00008000;
DBT_DEVICEREMOVECOMPLETE = $00008004;
DBT_DEVTYP_VOLUME = $00000002;
// Device structs
type
_DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;
DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;
TDevBroadcastHeader = DEV_BROADCAST_HDR;
PDevBroadcastHeader = ^TDevBroadcastHeader;
type
_DEV_BROADCAST_VOLUME = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: WORD;
end;
DEV_BROADCAST_VOLUME = _DEV_BROADCAST_VOLUME;
TDevBroadcastVolume = DEV_BROADCAST_VOLUME;
PDevBroadcastVolume = ^TDevBroadcastVolume;
implementation
procedure Register;
begin
RegisterComponents('Mojtaba', [TUSBDetector]);
end;
{ TUSBDetector }
constructor TUSBDetector.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWindowHandle := AllocateHWnd(WndProc);
end;
destructor TUSBDetector.Destroy;
begin
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
procedure TUSBDetector.WMDEVICECHANGE(var Msg: TMessage);
var
lpdbhHeader: PDevBroadcastHeader;
lpdbvData: PDevBroadcastVolume;
dwIndex: Integer;
lpszDrive: String;
begin
inherited;
// Get the device notification header
lpdbhHeader:=PDevBroadcastHeader(Msg.lParam);
// Handle the message
case Msg.WParam of
DBT_DEVICEARRIVAL: {a USB drive was connected}
begin
if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
lpdbvData:=PDevBroadcastVolume(Msg.lParam);
for dwIndex :=0 to 25 do
begin
if ((lpdbvData^.dbcv_unitmask shr dwIndex) = 1) then
begin
lpszDrive:=lpszDrive+Chr(65+dwIndex)+ ':';
Break;
end;
end;
if Assigned(OnArrival) then
OnArrival(Self, lpszDrive);
end;
end;
DBT_DEVICEREMOVECOMPLETE: {a USB drive was removed}
begin
if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
lpdbvData:=PDevBroadcastVolume(Msg.lParam);
for dwIndex:=0 to 25 do
begin
if ((lpdbvData^.dbcv_unitmask shr dwIndex) = 1) then
begin
lpszDrive:=lpszDrive+Chr(65+dwIndex)+ ':';
Break;
end;
end;
if Assigned(OnRemoved) then
OnRemoved(Self, lpszDrive);
end;
end;
end;
end;
procedure TUSBDetector.WndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_DEVICECHANGE) then
begin
try
WMDeviceChange(Msg);
except
Application.HandleException(Self);
end;
end
end;
end.usbdetector.pas
Kod: Tümünü seç
unit UsbDetector;
interface
uses Classes;
type
TUsbDriveChanged = procedure (Sender: TObject; Drive: string; Attached: boolean) of object;
procedure StartUsbDetector(NotifyProc: TUsbDriveChanged);
procedure StopUsbDetector;
implementation
uses Windows, Messages, Forms, SysUtils;
type
TUSBDetector = class(TObject)
private
fUsbDriveChanged: TUsbDriveChanged;
protected
procedure DeviceChanged(Msg: UINT; wParam, lParam: Longint);
procedure DoUsbDriveChanged(Drive: string; Attached: Boolean); dynamic;
public
constructor Create(NotifyProc: TUsbDriveChanged);
destructor Destroy; override;
property OnUsbDriveChanged: TUsbDriveChanged read fUsbDriveChanged;
end;
var mUSBDetector: TUSBDetector;
procedure StartUsbDetector(NotifyProc: TUsbDriveChanged);
begin
if not Assigned(mUsbDetector) then
mUsbDetector := TUsbDetector.Create(NotifyProc);
end;
procedure StopUsbDetector;
begin
FreeAndNil(mUsbDetector);
mUsbDetector := nil;
end;
{----------------------------------------------------------------------------}
// Device constants
const
DBT_DEVICEARRIVAL = $00008000;
DBT_DEVICEREMOVECOMPLETE = $00008004;
DBT_DEVTYP_VOLUME = $00000002;
// Device structs
type
_DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;
DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;
TDevBroadcastHeader = DEV_BROADCAST_HDR;
PDevBroadcastHeader = ^TDevBroadcastHeader;
type
_DEV_BROADCAST_VOLUME = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: WORD;
end;
DEV_BROADCAST_VOLUME = _DEV_BROADCAST_VOLUME;
TDevBroadcastVolume = DEV_BROADCAST_VOLUME;
PDevBroadcastVolume = ^TDevBroadcastVolume;
var
fPrevWndProc: TFNWndProc = nil;
function UsbWndProc(hWnd: HWND; Msg: UINT; wParam, lParam: Longint): Longint; stdcall;
begin
Result := CallWindowProc(fPrevWndProc, hWnd, Msg, wParam, lParam);
if (Msg = WM_DEVICECHANGE) and (mUsbDetector <> nil) then
mUsbDetector.DeviceChanged(Msg, wParam, lParam);
end;
constructor TUSBDetector.Create(NotifyProc: TUsbDriveChanged);
begin
inherited Create;
fUsbDriveChanged := NotifyProc;
fPrevWndProc := TFNWndProc(GetWindowLong(Application.Handle, GWL_WNDPROC));
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(@UsbWndProc));
end;
destructor TUSBDetector.Destroy;
begin
//SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(@fPrevWndProc));
inherited Destroy;
end;
procedure TUSBDetector.DeviceChanged(Msg: UINT; wParam, lParam: LongInt);
var
lpdbhHeader: PDevBroadcastHeader;
lpdbvData: PDevBroadcastVolume;
dwIndex: Integer;
lpszDrive: string;
begin
// Get the device notification header
lpdbhHeader := PDevBroadcastHeader(lParam);
// Handle the message
lpszDrive := 'Drive ';
case WParam of
DBT_DEVICEARRIVAL: {a USB drive was connected}
begin
if lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME then
begin
lpdbvData := PDevBroadcastVolume(lParam);
for dwIndex := 0 to 25 do
begin
if (lpdbvData^.dbcv_unitmask shr dwIndex) = 1 then
begin
lpszDrive := lpszDrive + Chr(65 + dwIndex) + ':';
break;
end;
end;
DoUsbDriveChanged(lpszDrive, True);
end;
end;
DBT_DEVICEREMOVECOMPLETE: {a USB drive was removed}
begin
if lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME then
begin
lpdbvData := PDevBroadcastVolume(lParam);
for dwIndex := 0 to 25 do
begin
if (lpdbvData^.dbcv_unitmask shr dwIndex) = 1 then
begin
lpszDrive := lpszDrive + Chr(65 + dwIndex) + ':';
break;
end;
end;
DoUsbDriveChanged(lpszDrive, False);
end;
end;
end;
end;
procedure TUSBDetector.DoUsbDriveChanged(Drive: string; Attached: Boolean);
begin
if Assigned(fUsbDriveChanged) then
fUsbDriveChanged(Self, Drive, Attached);
end;
end.Usb veri yazmak için kullandığım unit ama guidi doğru yazdığım halde genede veriyi yazmıyor.
Kod: Tümünü seç
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('\\?\USB\VID_0FCE&PID_ADDE&REV_0100{2AEB0243-6A6E-486B-82FC-D815F6B97006}', 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.
