#INCLUDE "Win32API.inc" '-------------------------------------------------------------------------------- %DIGCF_DEFAULT = &H00000001 %DIGCF_PRESENT = &H00000002 %DIGCF_ALLCLASSES = &H00000004 %DIGCF_PROFILE = &H00000008 %DIGCF_DEVICEINTERFACE = &H00000010 %WAIT_TIMEOUT = &H102& %WAIT_OBJECT_0 = 0 TYPE HIDD_ATTRIBUTES cbSize AS LONG VendorID AS INTEGER ProductID AS INTEGER VersionNumber AS INTEGER END TYPE TYPE SP_DEVICE_INTERFACE_DATA cbSize AS DWORD InterfaceClassGuid AS GUID Flags AS DWORD Reserved AS DWORD PTR END TYPE TYPE SP_DEVICE_INTERFACE_DETAIL_DATA cbSize AS DWORD DevicePath AS ASCIIZ * 256 END TYPE ' Device information structure (references a device instance ' that is a member of a device information set) TYPE SP_DEVINFO_DATA cbSize AS DWORD ClassGuid AS GUID DevInst AS DWORD ' DEVINST handle Reserved AS DWORD END TYPE '-------------------------------------------------------------------------------- ' ** Declarations ** '-------------------------------------------------------------------------------- DECLARE SUB HidD_GetHidGuid STDCALL LIB "HID.DLL" ALIAS "HidD_GetHidGuid" _ ( _ HidGuid AS GUID _ ) DECLARE FUNCTION HidD_GetAttributes STDCALL LIB "HID.DLL" ALIAS "HidD_GetAttributes" _ (BYVAL HidDeviceObject AS LONG, _ BYREF Attributes AS HIDD_ATTRIBUTES) _ AS LONG DECLARE FUNCTION SetupDiGetClassDevs LIB "Setupapi.dll" ALIAS "SetupDiGetClassDevsA" _ ( _ BYREF ClassGuid AS GUID, _ BYREF Enumerator AS DWORD, _ BYVAL hwndParent AS LONG, _ BYVAL Flags AS DWORD _ ) AS DWORD DECLARE FUNCTION SetupDiEnumDeviceInterfaces LIB "Setupapi.dll" ALIAS "SetupDiEnumDeviceInterfaces" _ ( _ BYVAL DeviceInfoSet AS DWORD, _ BYVAL DeviceInfoData AS DWORD, _ BYREF InterfaceClassGuid AS GUID, _ BYVAL MemberIndex AS DWORD, _ BYREF DeviceInterfaceData AS SP_DEVICE_INTERFACE_DATA _ ) AS LONG DECLARE FUNCTION SetupDiGetDeviceInterfaceDetail LIB "Setupapi.dll" ALIAS "SetupDiGetDeviceInterfaceDetailA" _ ( _ BYVAL DeviceInfoSet AS DWORD, _ BYREF DeviceInterfaceData AS SP_DEVICE_INTERFACE_DATA, _ BYREF DeviceInterfaceDetailData AS SP_DEVICE_INTERFACE_DETAIL_DATA, _ BYVAL DeviceInterfaceDetailDataSize AS DWORD, _ BYREF RequiredSize AS DWORD, _ BYVAL DeviceInfoData AS DWORD _ ) AS LONG DECLARE FUNCTION SetupDiDestroyDeviceInfoList LIB "Setupapi.dll" ALIAS "SetupDiDestroyDeviceInfoList" _ ( _ BYVAL DeviceInfoSet AS DWORD _ ) AS LONG DECLARE FUNCTION HidD_GetProductString STDCALL LIB "HID.DLL" ALIAS "HidD_GetProductString" _ ( _ BYVAL HidDeviceObject AS LONG, _ BYVAL Buffer AS DWORD, _ BYVAL BufferLength AS DWORD _ ) AS LONG ' Declares for functions in this module DECLARE FUNCTION OpenUSB(sDeviceName AS STRING, sError AS STRING) AS LONG DECLARE FUNCTION ReadUSB(sData AS STRING) AS LONG DECLARE FUNCTION WriteUSB(bData AS BYTE) AS LONG DECLARE SUB CloseUSB() '-------------------------------------------------------------------------------- ' HID handle GLOBAL glHidHandle AS LONG GLOBAL glrHidHandle AS LONG GLOBAL eventobject AS LONG GLOBAL HIDOverlapped AS OVERLAPPED GLOBAL security AS SECURITY_ATTRIBUTES DECLARE SUB DisplayResult(msg AS STRING) FUNCTION RFID_ThreadedRead(BYVAL lpdwParam AS LONG) AS INTEGER LOCAL Result AS LONG DO Result = ReadUSB( "") SLEEP 50 IF ISFALSE result THEN EXIT LOOP LOOP END FUNCTION FUNCTION test_rfid() AS INTEGER LOCAL NumOutputs, Result, RFID AS LONG LOCAL CUSBHandle AS LONG LOCAL ThreadHandle AS LONG LOCAL FunctionHandle AS LONG LOCAL sProductName AS STRING Result = OpenUSB ("USB_RFID", sProductName) IF ISFALSE Result THEN DisplayResult "Cannot find USB_RFID" EXIT FUNCTION END IF THREAD CREATE RFID_ThreadedRead(RFID) TO ThreadHandle PRINT "And we wait for it to shut down from an error, or 10 second timeout" WriteUSB 11 WaitForSingleObject(ThreadHandle, 2000000) CloseUSB glHidHandle=0 DisplayResult "" END FUNCTION FUNCTION PBMAIN () AS LONG test_rfid END FUNCTION SUB DisplayResult(msg AS STRING) #IF %DEF(%PB_CC32) PRINT msg PRINT "Press a key..."; WAITKEY$ LOCATE ,1 #ELSE MSGBOX msg, &H00001000& ' %MB_SYSTEMMODAL #ENDIF END SUB FUNCTION OpenUSB(sDeviceName AS STRING, sProductName AS STRING) AS LONG ' ' Function: Find a given device name in the system HID tables ' Accepts : sDeviceName - Device to search for ' Returns : True on success, False on failure ' LOCAL I AS LONG LOCAL dwInstance AS DWORD, dwReqLen AS DWORD LOCAL hDevInfo AS DWORD PTR LOCAL sBuffer AS STRING * 256 'LOCAL sProductName AS STRING LOCAL tHidGuid AS GUID LOCAL tIfcData AS SP_DEVICE_INTERFACE_DATA LOCAL tIfcDetail AS SP_DEVICE_INTERFACE_DETAIL_DATA DIM DeviceAttributes AS HIDD_ATTRIBUTES DIM result AS LONG Security.lpSecurityDescriptor = 0 Security.bInheritHandle = %TRUE Security.nLength = SIZEOF(Security) OpenUSB = %FALSE ' Get the GUID of the HID interface HidD_GetHidGuid tHidGuid ' Init some items tIfcData.cbSize = SIZEOF(tIfcData) tIfcDetail.cbSize = 5 ' Get handle to relevant device information set hDevInfo = SetupDiGetClassDevs(tHidGuid, %NULL, %NULL, %DIGCF_PRESENT OR %DIGCF_DEVICEINTERFACE) IF hDevInfo = %INVALID_HANDLE_VALUE THEN EXIT FUNCTION DO ' Get interface data for the requested instance IF ISFALSE SetupDiEnumDeviceInterfaces(hDevInfo, %NULL, tHidGuid, dwInstance, tIfcData) THEN SetupDiDestroyDeviceInfoList hDevInfo EXIT DO END IF ' Get size of symbolic link name SetupDiGetDeviceInterfaceDetail hDevInfo, tIfcData, BYVAL %NULL, 0???, dwReqLen, %NULL IF dwReqLen = 0 THEN SetupDiDestroyDeviceInfoList hDevInfo EXIT DO END IF ' Get symbolic link name IF ISFALSE SetupDiGetDeviceInterfaceDetail(hDevInfo, tIfcData, tIfcDetail, dwReqLen, BYVAL %NULL, %NULL) THEN SetupDiDestroyDeviceInfoList hDevInfo EXIT DO END IF ' Open file glHidHandle = CreateFile(tIfcDetail.DevicePath, %GENERIC_READ OR %GENERIC_WRITE, _ %FILE_SHARE_READ OR %FILE_SHARE_WRITE, security, _ %OPEN_EXISTING, 0&, 0& ) 'print glHidHandle DeviceAttributes.cbSize = SIZEOF(DeviceAttributes) Result = HidD_GetAttributes _ (glHidHandle, _ DeviceAttributes) IF result THEN 'msgbox hex$(DeviceAttributes.VendorID) END IF glrHidHandle = CreateFile(tIfcDetail.DevicePath, %GENERIC_READ OR %GENERIC_WRITE, _ %FILE_SHARE_READ OR %FILE_SHARE_WRITE, security, _ %OPEN_EXISTING, %FILE_FLAG_OVERLAPPED, 0& ) IF glHidHandle = %INVALID_HANDLE_VALUE THEN SetupDiDestroyDeviceInfoList hDevInfo EXIT DO END IF sBuffer = SPACE$(255) IF HidD_GetProductString(glHidHandle , VARPTR(sBuffer), 255) THEN ' Convert from wide char to ANSI sProductName = SPACE$(LEN(sBuffer) \ 2) FOR I = 1 TO 255 STEP 2 sProductName = sProductName & MID$(sBuffer, I, 1) NEXT 'Msgbox Trim$(sProductName) ' Is this the device requested? IF INSTR(1, sProductName, sDeviceName) THEN IF EventObject = 0 THEN EventObject = CreateEvent _ (Security, _ 0&, _ 0&, _ BYVAL %NULL) END IF 'msgbox "EO:" + str$(Eventobject) 'Set the members of the overlapped structure. HIDOverlapped.Offset = 0 HIDOverlapped.OffsetHigh = 0 HIDOverlapped.hEvent = EventObject OpenUSB = %TRUE EXIT DO END IF END IF ' Not the device requested, so close the handle CloseHandle glHidHandle glHidHandle=0 INCR dwInstance LOOP END FUNCTION ' ********************************************************************************* FUNCTION ReadUSB(sDatax AS STRING) AS LONG ' ' Function: Read data (Input Report) from an opened USB device ' Accepts : Nothing ' Returns : True on success, False on failure ' sData - Input report data if the function succeeds ' Comments: ReadFile() is a BLOCKING system call, ie it will wait for the USB device to respond. ' LOCAL lBytesReturned AS LONG LOCAL sData AS STRING LOCAL lclhd AS LONG LOCAL sReportBuffer AS ASCIIZ *8 LOCAL lcli AS LONG LOCAL pbByte AS BYTE PTR DIM sReportBuffer(16) AS BYTE ReadUSB = %FALSE 'sReportBuffer=SPACE$(8) lBytesReturned=0 ' Get the data sData="" lclhd=ReadFile(glrHidHandle, sReportBuffer(0), 8, lBytesReturned, HIDOverlapped) lclhd = WaitForSingleObject _ (EventObject, _ 5000) IF lclhd=%WAIT_OBJECT_0 THEN ' Return the data; leave off the ReportID (the first character) since for keyboards it's always 0 FOR lcli = 1 TO lBytesReturned - 2: sdata=sdata + HEX$(sReportBuffer(lcli)): NEXT PRINT LCASE$(sdata) ReadUSB = %TRUE END IF END FUNCTION ' ********************************************************************************* FUNCTION WriteUSB(bData AS BYTE) AS LONG ' ' Function: Write data (Output Report) to an opened USB device ' Accepts : bData - Data byte to send ' Returns : True on success, False on failure ' Comments: Keyboard output reports are only 2 bytes long; 1st byte is always 0 for keyboard reports ' LOCAL lclres AS LONG LOCAL lBytesWritten AS LONG DIM bReportBuffer(4) AS BYTE 'DIM bReportBuffer AS asciiz * 6 DIM pbptr AS BYTE PTR bReportBuffer(0) = 0 ' Report ID; 0 = keyboard bReportBuffer(1) = bData bReportBuffer(2) = 1 bReportBuffer(3) = 0 bReportBuffer(4) = 0 'pbptr=varptr(bReportBuffer) '@pbptr[0] = &H0 ' Report ID; 0 = keyboard '@pbptr[1] = &HC '@pbptr[2] = &H1 '@pbptr[3] = &H0 '@pbptr[4] = &H0 lBytesWritten=0 lclres = WriteFile(glHidHandle,bReportBuffer(0), 5, lBytesWritten, BYVAL 0&) IF lclres THEN WriteUSB = %TRUE ELSE WriteUSB = %FALSE END IF END FUNCTION ' ********************************************************************************* SUB CloseUSB() ' ' Function: Close the USB device ' Accepts : Nothing ' Returns : Nothing ' CloseHandle glHidHandle END SUBSome of the resources I'm using: