Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Volunteers to Convert VB Code to VFP?
Message
From
12/09/2006 17:04:47
 
 
To
All
General information
Forum:
Visual FoxPro
Category:
Windows API functions
Title:
Volunteers to Convert VB Code to VFP?
Environment versions
Visual FoxPro:
VFP 9
OS:
Windows XP SP2
Network:
Windows 2003 Server
Database:
MS SQL Server
Miscellaneous
Thread ID:
01153155
Message ID:
01153155
Views:
109
I have a LOT of these declarations and functions to work my way through (working with the hidD api and no examples could be found in VFP) so I thought I would post a few and see if anyone wanted to volunteer to convert some of these to VFP? This is one of 20 from the Phidgets stuff... (sheesh!) But this one, when completed will get me started communicating to/from to a standard USB device....(Now back to the rest of them! :o) *G* It may be something useful in the future...
#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 SUB
Some of the resources I'm using:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/hid_d/hh/HID_d/hidclass_41d90743-77d6-42dc-a1e5-501c26b7e53e.xml.asp
http://www.microsoft.com/mspress/books/sampchap/6262.asp
http://www.ime.jku.at/TUSB/pdfs/HID-Treiber.pdf#search=%22hidd_get%22
http://www2.hawaii.edu/~hermany/hid.htm
http://users.ece.gatech.edu/~hamblen/489X/f04proj/CNC/4180%20Project/Files/steppermon/hidusb.cpp
http://www.microsoft.com/whdc/resources/downloads.mspx
http://www.lvr.com/hidpage.htm
http://www.lvr.com/usbcode.htm
.·*´¨)
.·`TCH
(..·*

010000110101001101101000011000010111001001110000010011110111001001000010011101010111001101110100
"When the debate is lost, slander becomes the tool of the loser." - Socrates
Vita contingit, Vive cum eo. (Life Happens, Live With it.)
"Life is not measured by the number of breaths we take, but by the moments that take our breath away." -- author unknown
"De omnibus dubitandum"
Next
Reply
Map
View

Click here to load this message in the networking platform