module1.bas

温度显示器,用CYPRESS IC

Attribute VB_Name = "Module1"
'*****************************************************************
'Custom Variables.
'*****************************************************************
 Public IOCTL_Cyusb_GET_DEVICE_DESCRIPTOR As Long
 Public IOCTL_Cyusb_GET_CONFIGURATION_DESCRIPTOR As Long
 Public IOCTL_Cyusb_GET_STRING_DESCRIPTOR As Long
 Public IOCTL_Cyusb_VENDOR_REQUEST As Long
 
 Public MinTemper As Integer
 Public MaxTemper As Integer
 Public TemperScale As Integer
 Public DrawScale As Integer
 Public CurTemper As Integer
 Public PushBut As Integer
 Public TLowtemper As Integer
 Public THightemper As Integer
 
 Public Type VENDOR_REQUEST_IN
    bRequest As Byte
    wValue As Integer
    wIndex As Integer
    wLength As Integer
    direction As Byte
    bData As Byte
End Type

Public Type GET_STRING_DESCRIPTOR_IN
    Index As Byte
    LanguageId As Integer
End Type

'*****************************************************************
'API constants.
'*****************************************************************
'IOCTL Code
Public Const FILE_DEVICE_UNKNOWN = &H22
Public Const Cyusb_IOCTL_INDEX = &H800
Public Const METHOD_BUFFERED = &H0
Public Const FILE_ANY_ACCESS = &H0
'CreateFile
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_SHARE_WRITE = &H2
Public Const OPEN_EXISTING = 3
Public Const INVALID_HANDLE_VALUE = -1

'*****************************************************************
'API functions.
'*****************************************************************
Public Declare Function CreateFile _
       Lib "kernel32" _
       Alias "CreateFileA" _
       (ByVal lpFileName As String, _
       ByVal dwDesiredAccess As Long, _
       ByVal dwShareMode As Long, _
       ByRef lpSecurityAttributes As Long, _
       ByVal dwCreationDisposition As Long, _
       ByVal dwFlagsAndAttributes As Long, _
       ByVal hTemplateFile As Long) _
As Long

Public Declare Function CloseHandle _
    Lib "kernel32" _
    (ByVal hObject As Long) _
As Long

Public Declare Function DeviceIoControl _
       Lib "kernel32" _
       (ByVal hDevice As Long, _
       ByVal dwIoControlCode As Long, _
       ByRef lpInBuffer As Any, _
       ByVal nInBufferSize As Long, _
       ByRef lpOutBuffer As Byte, _
       ByVal nOutBufferSize As Long, _
       ByRef lpBytesReturned As Long, _
       ByRef lpOverlapped As Long) _
As Long

'*****************************************************************
'Custom Functions.
'*****************************************************************
Public Function CTL_CODE(DeviceType As Long, Functions As Long, Method As Long, Access As Long) As Long
       CTL_CODE = DeviceType * 2 ^ 16 Or Access * 2 ^ 14 Or Functions * 2 ^ 2 Or Method
End Function

Public Function Initialize() As Boolean
Dim myRequest As VENDOR_REQUEST_IN
Dim bResult As Boolean
Dim ReData(8) As Byte
Dim nBytes As Long
Dim HidDevice As Long
Dim DevicePathName As String

DevicePathName = "\\.\Cyusb-0"
If (OpenDevice(HidDevice, DevicePathName) = True) Then
    myRequest.bRequest = &H6
    myRequest.wValue = &H1
    myRequest.wIndex = &H0
    myRequest.wLength = &H8
    myRequest.bData = &H0
    myRequest.direction = &H1
            
    bResult = DeviceIoControl _
              (HidDevice, _
              IOCTL_Cyusb_VENDOR_REQUEST, _
              myRequest, _
              10, _
              ReData(0), _
              8, _
              nBytes, _
              0)
    If (bResult = True) Then
        CurTemper = ReData(2) / 2
        Initialize = True
    Else
        Initialize = False
        Form1.Shape6.Height = (MaxTemper - 0) * TemperScale
        Form1.Image1.Picture = LoadPicture("")
        Form1.Image2.Picture = LoadPicture("")
        
        MsgBox "    与USB设备通信失败！" + _
              Chr(13) & Chr(10) + _
              "USB数据传输错误，请重新启动硬件！", _
              16, "CurTemper错误"
        CloseHandle (HidDevice)
        Unload Form1
        End
    End If
    
    '读取TLowtemper的值。
    myRequest.bRequest = &HA
    myRequest.wValue = &H0
    myRequest.wIndex = &H0
    myRequest.wLength = &H8
    myRequest.bData = &H0
    myRequest.direction = &H1
        
    bResult = DeviceIoControl _
              (HidDevice, _
              IOCTL_Cyusb_VENDOR_REQUEST, _
              myRequest, _
              10, _
              ReData(0), _
              8, _
              nBytes, _
              0)
    If (bResult = True) Then
        TLowtemper = ReData(2) / 2
    Else
        Initialize = False
        MsgBox "    与USB设备通信失败！" + _
               Chr(13) & Chr(10) + _
               "USB数据传输错误，请重新启动硬件1！", _
               16, "TLow错误"
        CloseHandle (HidDevice)
        Unload Form1
        End
    End If
    
    myRequest.bRequest = &H8
    myRequest.wValue = &H0
    myRequest.wIndex = &H0
    myRequest.wLength = &H8
    myRequest.bData = &H0
    myRequest.direction = &H1
        
    bResult = DeviceIoControl _
              (HidDevice, _
              IOCTL_Cyusb_VENDOR_REQUEST, _
              myRequest, _
              10, _
              ReData(0), _
              8, _
              nBytes, _
              0)
    If (bResult = True) Then
        THightemper = ReData(2) / 2
        CloseHandle (HidDevice)
    Else
        Initialize = False
        MsgBox "    与USB设备通信失败！" + _
               Chr(13) & Chr(10) + _
               "USB数据传输错误，请重新启动硬件！", _
               16, "THigh错误"
        CloseHandle (HidDevice)
        Unload Form1
        End
    End If
Else
    Initialize = False
End If
End Function

Public Function OpenDevice(ByRef HidDevice As Long, ByVal DevicePathName As String) As Boolean
       HidDevice = CreateFile _
                   (DevicePathName, _
                   GENERIC_WRITE, _
                   FILE_SHARE_WRITE, _
                   0, _
                   OPEN_EXISTING, _
                   0, _
                   0)
       If (HidDevice = INVALID_HANDLE_VALUE) Then
           OpenDevice = False
           Form1.Shape6.Height = (MaxTemper - 0) * TemperScale
           Form1.Image1.Picture = LoadPicture("")
           Form1.Image2.Picture = LoadPicture("")
           
           MsgBox "  未发现与之通信的USB设备！" + _
              Chr(13) & Chr(10) + _
              Chr(13) & Chr(10) + _
              "1.请确定其硬件设备是否已连接。" + _
              Chr(13) & Chr(10) + _
              "2.请确定其驱动程序是否已加载。", _
              16, "OpenDevice错误"
           
           Form1.Timer1.Enabled = False
           Form1.Timer2.Enabled = True
       Else
           OpenDevice = True
       End If
End Function