module1.bas

Visual basic in embeddd systems to inhance th gui

Attribute VB_Name = "Module1"
Option Explicit

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'Function OpenThePort() As Integer


'About overlapped I/O
'
'Reading HID Input reports is done with the API function ReadFile.
'Non-overlapped ReadFile is a blocking call. If the device doesn't return the
'expected amount of data, the application hangs and waits endlessly.
'application
'With overlapped I/O, the call to ReadFile returns immediately. The  uses
'WaitForSingleObject to be notified either that the data has arrived or that a timeout
'has occurred.
'WaitForSingleObject blocks the application thread but specifies a timeout value so the
'application's thread isn't blocked forever.
'
'This application has been tested on Windows 98 SE and Windows 2000.

Dim bAlertable As Long
Dim Capabilities As HIDP_CAPS
Dim DataString As String
Dim DetailData As Long
Dim DetailDataBuffer() As Byte
Dim DeviceAttributes As HIDD_ATTRIBUTES
Dim DevicePathName As String
Dim DeviceInfoSet As Long
Dim ErrorString As String
Dim EventObject As Long
Dim HIDHandle As Long
Dim HIDOverlapped As OVERLAPPED
Dim LastDevice As Boolean
Dim MyDeviceDetected As Boolean
Dim MyDeviceInfoData As SP_DEVINFO_DATA
Dim MyDeviceInterfaceDetailData As SP_DEVICE_INTERFACE_DETAIL_DATA
Dim MyDeviceInterfaceData As SP_DEVICE_INTERFACE_DATA
Dim Needed As Long
Dim PreparsedData As Long
Public ReadBuffer() As Byte

Dim ReadHandle As Long
Dim Result As Long

'Set these to match the values in the device's firmware and INF file.
'0925h is Lakeview Research's vendor ID.
Const MyVendorID = 1240
Const MyProductID = 50

Const INCADDRESS = &H49 ' I
Const ENTERPGM = &H50   ' P - enter program mode
Const EXITPGM = &H70    ' p - exit program mode
Const WRITEPGM = &H57   ' W
Const WRITECONFIG = &H43 ' C - Set address to config memory
Const WRITEDATA = &H44  ' D
Const ERASEPGM = &H45   ' E
Const ERASEDATA = &H65  ' e
Const READPGM = &H52    ' R
Const READDATA = &H72   ' r
Const CHKSUM = &H53     ' S
Const GETVERSION = &H76 ' v
Const POWERCTRL = &H56  ' V
Const NULLCMD = 122     ' Z
Const CMDTABLE = &H63   ' c - Download 6 bit programming command table

Const MAXDATASAMPLES = 87000
Global Temperature(MAXDATASAMPLES) As Single
Global Photo(MAXDATASAMPLES) As Single
Global Humidity(MAXDATASAMPLES) As Single

Function FindTheHid() As Boolean
'Makes a series of API calls to locate the desired HID-class device.
'Returns True if the device is detected, False if not detected.

Dim Count As Integer
Dim GUIDString As String
Dim HidGuid As GUID
Dim MemberIndex As Long

LastDevice = False
MyDeviceDetected = False

'******************************************************************************
'HidD_GetHidGuid
'Get the GUID for all system HIDs.
'Returns: the GUID in HidGuid.
'The routine doesn't return a value in Result
'but the routine is declared as a function for consistency with the other API calls.
'******************************************************************************

Result = HidD_GetHidGuid(HidGuid)
Call DisplayResultOfAPICall("GetHidGuid")

'Display the GUID.
GUIDString = _
    Hex$(HidGuid.Data1) & "-" & _
    Hex$(HidGuid.Data2) & "-" & _
    Hex$(HidGuid.Data3) & "-"

For Count = 0 To 7
    'Ensure that each of the 8 bytes in the GUID displays two characters.
    If HidGuid.Data4(Count) >= &H10 Then
        GUIDString = GUIDString & Hex$(HidGuid.Data4(Count)) & " "
    Else
        GUIDString = GUIDString & "0" & Hex$(HidGuid.Data4(Count)) & " "
    End If
Next Count

'lstResults.AddItem "  GUID for system HIDs: " & GUIDString

'******************************************************************************
'SetupDiGetClassDevs
'Returns: a handle to a device information set for all installed devices.
'Requires: the HidGuid returned in GetHidGuid.
'******************************************************************************

DeviceInfoSet = SetupDiGetClassDevs _
    (HidGuid, _
    vbNullString, _
    0, _
    (DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE))
    
Call DisplayResultOfAPICall("SetupDiClassDevs")
DataString = GetDataString(DeviceInfoSet, 32)

'******************************************************************************
'SetupDiEnumDeviceInterfaces
'On return, MyDeviceInterfaceData contains the handle to a
'SP_DEVICE_INTERFACE_DATA structure for a detected device.
'Requires:
'the DeviceInfoSet returned in SetupDiGetClassDevs.
'the HidGuid returned in GetHidGuid.
'An index to specify a device.
'******************************************************************************

'Begin with 0 and increment until no more devices are detected.
MemberIndex = 0

Do
    'The cbSize element of the MyDeviceInterfaceData structure must be set to
    'the structure's size in bytes. The size is 28 bytes.
    MyDeviceInterfaceData.cbSize = LenB(MyDeviceInterfaceData)
    Result = SetupDiEnumDeviceInterfaces _
        (DeviceInfoSet, _
        0, _
        HidGuid, _
        MemberIndex, _
        MyDeviceInterfaceData)
    
    Call DisplayResultOfAPICall("SetupDiEnumDeviceInterfaces")
    If Result = 0 Then LastDevice = True
    
    'If a device exists, display the information returned.
    If Result <> 0 Then
'        lstResults.AddItem "  DeviceInfoSet for device #" & CStr(MemberIndex) & ": "
'        lstResults.AddItem "  cbSize = " & CStr(MyDeviceInterfaceData.cbSize)
'        lstResults.AddItem _
            "  InterfaceClassGuid.Data1 = " & Hex$(MyDeviceInterfaceData.InterfaceClassGuid.Data1)
'        lstResults.AddItem _
            "  InterfaceClassGuid.Data2 = " & Hex$(MyDeviceInterfaceData.InterfaceClassGuid.Data2)
'        lstResults.AddItem _
            "  InterfaceClassGuid.Data3 = " & Hex$(MyDeviceInterfaceData.InterfaceClassGuid.Data3)
'        lstResults.AddItem _
            "  Flags = " & Hex$(MyDeviceInterfaceData.Flags)
    
        
        '******************************************************************************
        'SetupDiGetDeviceInterfaceDetail
        'Returns: an SP_DEVICE_INTERFACE_DETAIL_DATA structure
        'containing information about a device.
        'To retrieve the information, call this function twice.
        'The first time returns the size of the structure in Needed.
        'The second time returns a pointer to the data in DeviceInfoSet.
        'Requires:
        'A DeviceInfoSet returned by SetupDiGetClassDevs and
        'an SP_DEVICE_INTERFACE_DATA structure returned by SetupDiEnumDeviceInterfaces.
        '*******************************************************************************
        
        MyDeviceInfoData.cbSize = Len(MyDeviceInfoData)
        Result = SetupDiGetDeviceInterfaceDetail _
           (DeviceInfoSet, _
           MyDeviceInterfaceData, _
           0, _
           0, _
           Needed, _
           0)
        
        DetailData = Needed
            
        Call DisplayResultOfAPICall("SetupDiGetDeviceInterfaceDetail")
   '     lstResults.AddItem "  (OK to say too small)"
   '     lstResults.AddItem "  Required buffer size for the data: " & Needed
        
        'Store the structure's size.
        MyDeviceInterfaceDetailData.cbSize = _
            Len(MyDeviceInterfaceDetailData)
        
        'Use a byte array to allocate memory for
        'the MyDeviceInterfaceDetailData structure
        ReDim DetailDataBuffer(Needed)
        'Store cbSize in the first four bytes of the array.
        Call RtlMoveMemory _
            (DetailDataBuffer(0), _
            MyDeviceInterfaceDetailData, _
            4)
        
        'Call SetupDiGetDeviceInterfaceDetail again.
        'This time, pass the address of the first element of DetailDataBuffer
        'and the returned required buffer size in DetailData.
        Result = SetupDiGetDeviceInterfaceDetail _
           (DeviceInfoSet, _
           MyDeviceInterfaceData, _
           VarPtr(DetailDataBuffer(0)), _
           DetailData, _
           Needed, _
           0)
        
        Call DisplayResultOfAPICall(" Result of second call: ")
   '     lstResults.AddItem "  MyDeviceInterfaceDetailData.cbSize: " & _
            CStr(MyDeviceInterfaceDetailData.cbSize)
        
        'Convert the byte array to a string.
        DevicePathName = CStr(DetailDataBuffer())
        'Convert to Unicode.
        DevicePathName = StrConv(DevicePathName, vbUnicode)
        'Strip cbSize (4 bytes) from the beginning.
        DevicePathName = Right$(DevicePathName, Len(DevicePathName) - 4)
   '     lstResults.AddItem "  Device pathname: "
   '     lstResults.AddItem "    " & DevicePathName
                
        '******************************************************************************
        'CreateFile
        'Returns: a handle that enables reading and writing to the device.
        'Requires:
        'The DevicePathName returned by SetupDiGetDeviceInterfaceDetail.
        '******************************************************************************
    
        HIDHandle = CreateFile _
            (DevicePathName, _
            GENERIC_READ Or GENERIC_WRITE, _
            (FILE_SHARE_READ Or FILE_SHARE_WRITE), _
            0, _
            OPEN_EXISTING, _
            0&, _
            0)
            
        Call DisplayResultOfAPICall("CreateFile")
    '    lstResults.AddItem "  Returned handle: " & Hex$(HIDHandle) & "h"
        
        'Now we can find out if it's the device we're looking for.
        
        '******************************************************************************
        'HidD_GetAttributes
        'Requests information from the device.
        'Requires: The handle returned by CreateFile.
        'Returns: an HIDD_ATTRIBUTES structure containing
        'the Vendor ID, Product ID, and Product Version Number.
        'Use this information to determine if the detected device
        'is the one we're looking for.
        '******************************************************************************
        
        'Set the Size property to the number of bytes in the structure.
        DeviceAttributes.Size = LenB(DeviceAttributes)
        Result = HidD_GetAttributes _
            (HIDHandle, _
            DeviceAttributes)
            
        Call DisplayResultOfAPICall("HidD_GetAttributes")
 '       If Result <> 0 Then
 '           lstResults.AddItem "  HIDD_ATTRIBUTES structure filled without error."
 '       Else
 '           lstResults.AddItem "  Error in filling HIDD_ATTRIBUTES structure."
 '       End If
    
'        lstResults.AddItem "  Structure size: " & DeviceAttributes.Size
'        lstResults.AddItem "  Vendor ID: " & Hex$(DeviceAttributes.VendorID)
'        lstResults.AddItem "  Product ID: " & Hex$(DeviceAttributes.ProductID)
 '       lstResults.AddItem "  Version Number: " & Hex$(DeviceAttributes.VersionNumber)
        
        'Find out if the device matches the one we're looking for.
        If (DeviceAttributes.VendorID = MyVendorID) And _
            (DeviceAttributes.ProductID = MyProductID) Then
                'It's the desired device.
 '               lstResults.AddItem "  My device detected"
                MyDeviceDetected = True
        Else
                MyDeviceDetected = False
                'If it's not the one we want, close its handle.
                Result = CloseHandle _
                    (HIDHandle)
                DisplayResultOfAPICall ("CloseHandle")
        End If
End If
    'Keep looking until we find the device or there are no more left to examine.
    MemberIndex = MemberIndex + 1
Loop Until (LastDevice = True) Or (MyDeviceDetected = True)

'Free the memory reserved for the DeviceInfoSet returned by SetupDiGetClassDevs.
Result = SetupDiDestroyDeviceInfoList _