我现在的代码.txt

单片机的C语言程序

'sendDat(7) = &H80
Call WriteDevice(SendDat(0), 1)
'Call CTL_CODE(FILE_DEVICE, Write_Endp1, METHOD_BUFFERED, FILE_ANY_ACCESS)
'Call DeviceIoControl(HidDevice,)
lstResults.AddItem " 发送的数据为:"
For count = 0 To UBound(SendDat)
      lstResults.AddItem " " & Hex$(SendDat(count))
Next count
Else
MsgBox "数值不能大于255"
End If
End Sub
'关闭设备
Private Sub Close_Dev_Click()
'hid.closedevice '关闭HID设备
Open_Dev.Enabled = True
Close_Dev.Enabled = False
Timer1.Enabled = False
Key1.BackColor = RGB(255, 0, 0)
Key2.BackColor = RGB(255, 0, 0)
Call Shutdown
End Sub

'控制LED1
Private Sub Led_Off_1_Click(Index As Integer)
Dim SendDat(0) As Byte
SendDat(0) = &HFE
Call WriteDevice(SendDat(0), 1)
End Sub

'控制LED2
Private Sub Led_Off_2_Click(Index As Integer)
Index = 1
Dim SendDat(0) As Byte
SendDat(0) = &HFD
Call WriteDevice(SendDat(0), 1)
End Sub

'控制LED3
Private Sub Led_Off_3_Click(Index As Integer)
Index = 2
Dim SendDat(0) As Byte
SendDat(0) = &HFB
Call WriteDevice(SendDat(0), 1)
End Sub


'控制LED4
Private Sub Led_Off_4_Click(Index As Integer)
Index = 3
Dim SendDat(0) As Byte
SendDat(0) = &HF7
Call WriteDevice(SendDat(0), 1)
End Sub


'控制LED5
Private Sub Led_Off_5_Click(Index As Integer)
Index = 4
Dim SendDat(0) As Byte
SendDat(0) = &HEF
Call WriteDevice(SendDat(0), 1)
End Sub

'控制LED6
Private Sub Led_Off_6_Click(Index As Integer)
Index = 5
Dim SendDat(0) As Byte
SendDat(0) = &HDF
Call WriteDevice(SendDat(0), 1)
End Sub

'控制LED7
Private Sub Led_Off_7_Click(Index As Integer)
Index = 6
Dim SendDat(0) As Byte
SendDat(0) = &HBF
Call WriteDevice(SendDat(0), 1)
End Sub

'控制LED8
Private Sub Led_Off_8_Click(Index As Integer)
Index = 7
Dim SendDat(0) As Byte
SendDat(0) = &H7F
Call WriteDevice(SendDat(0), 1)
End Sub

Private Sub Led_On_1_Click(Index As Integer)
Dim SendDat(0) As Byte
SendDat(0) = &H1
Call WriteDevice(SendDat(0), 1)
End Sub




Private Sub Led_On_2_Click(Index As Integer)
Index = 1
Dim SendDat(0) As Byte
SendDat(0) = &H2
Call WriteDevice(SendDat(0), 1)
End Sub

Private Sub Led_On_3_Click(Index As Integer)
Index = 2
Dim SendDat(0) As Byte
SendDat(0) = &H4
Call WriteDevice(SendDat(0), 1)
End Sub



Private Sub Led_On_6_Click(Index As Integer)
Index = 5
Dim SendDat(0) As Byte
SendDat(0) = &H20
Call WriteDevice(SendDat(0), 1)
End Sub

Private Sub Led_On_7_Click(Index As Integer)
Index = 6
Dim SendDat(0) As Byte
SendDat(0) = &H40
Call WriteDevice(SendDat(0), 1)
End Sub

Private Sub Led_On_8_Click(Index As Integer)
Index = 7
Dim SendDat(0) As Byte
SendDat(0) = &H80
Call WriteDevice(SendDat(0), 1)
End Sub


'调用API函数 返回错误字符串
Private Function GetErrorString _
    (ByVal LastError As Long) _
As String
Dim Bytes As Long
Dim ErrorString As String
ErrorString = String$(129, 0)
Bytes = FormatMessage _
    (FORMAT_MESSAGE_FROM_SYSTEM, _
    0&, _
    LastError, _
    0, _
    ErrorString$, _
    128, _
    0)
    '从信息中跳过CR和LF字符,因为减去两个字符
If Bytes > 2 Then
    GetErrorString = Left$(ErrorString, Bytes - 2)  'Left$表示返回的字符串
End If

End Function

'显示调用API的结果
Private Sub DisplayResultOfAPICall(FunctionName As String)
Dim ErrorString As String
lstResults.AddItem ""
ErrorString = GetErrorString(Err.LastDllError)
lstResults.AddItem FunctionName
lstResults.AddItem "  Result = " & ErrorString
End Sub

'返回数据字符串
Private Function GetDataString _
    (Address As Long, _
    Bytes As Long) _
As String
Dim Offset As Integer
Dim Result$
Dim ThisByte As Byte
For Offset = 0 To Bytes - 1
    Call RtlMoveMemory(ByVal VarPtr(ThisByte), ByVal Address + Offset, 1)
    If (ThisByte And &HF0) = 0 Then
        Result$ = Result$ & "0"
    End If
    Result$ = Result$ & Hex$(ThisByte) & " "
Next Offset
GetDataString = Result$
End Function

'用来返回设备特征信息
'该函数的返回值:包含一个指向关于此设备特征信息的缓冲区指针
'需要由CreateFlie函数返回设备的句柄
'因为圈圈的板不是HID设备,所以不用调用HidD_GetPreparsedData函数
'Private Sub GetDeviceCapabilities()
'Dim ppData(29) As Byte
'Dim ppDataString As Variant
'Variant 是一种特殊的数据类型，除了定长 String 数据及用户定义类型外，
'可以包含任何种类的数据
'预分析的数据(PreparsedData)指针指向函数声明的缓冲区
'Result = HidD_GetPreparsedData _
 '   (HidDevice, _
 '   PreparsedData)
'Call DisplayResultOfAPICall("HidD_GetPreparsedData")
'将位于PreparsedData中的数据复制到字节数组中
'Result = RtlMoveMemory _
    (ppData(0), _
     PreparsedData, _
    30)
'Call DisplayResultOfAPICall("RtlMoveMemory")
'ppDataString = ppData()
'ppDataString = StrConv(ppDataString, vbUnicode)
'HidP_GetCaps函数
'返回相关信息特征的结构,找到设备的特征
'Result = HidP_GetCaps _
'   (PreparsedData, _
 '   Capabilities)
'Call DisplayResultOfAPICall("HidP_GetCaps")
'lstResults.AddItem "  Last error: " & ErrorString
'lstResults.AddItem "  Usage: " & Hex$(Capabilities.Usage)
'lstResults.AddItem "  Usage Page: " & Hex$(Capabilities.UsagePage)
'lstResults.AddItem "  Input Report Byte Length: " & Capabilities.InputReportByteLength
'lstResults.AddItem "  Output Report Byte Length: " & Capabilities.OutputReportByteLength
'lstResults.AddItem "  Feature Report Byte Length: " & Capabilities.FeatureReportByteLength
'lstResults.AddItem "  Number of Link Collection Nodes: " & Capabilities.NumberLinkCollectionNodes
'lstResults.AddItem "  Number of Input Button Caps: " & Capabilities.NumberInputButtonCaps
'lstResults.AddItem "  Number of Input Value Caps: " & Capabilities.NumberInputValueCaps
'lstResults.AddItem "  Number of Input Data Indices: " & Capabilities.NumberInputDataIndices
'lstResults.AddItem "  Number of Output Button Caps: " & Capabilities.NumberOutputButtonCaps
'lstResults.AddItem "  Number of Output Value Caps: " & Capabilities.NumberOutputValueCaps
'lstResults.AddItem "  Number of Output Data Indices: " & Capabilities.NumberOutputDataIndices
'lstResults.AddItem "  Number of Feature Button Caps: " & Capabilities.NumberFeatureButtonCaps
'stResults.AddItem "  Number of Feature Value Caps: " & Capabilities.NumberFeatureValueCaps
'lstResults.AddItem "  Number of Feature Data Indices: " & Capabilities.NumberFeatureDataIndices

'HidP_GetValueCaps函数返回一个包含HidP_GetValueCaps结构数组的缓冲区
'Dim ValueCaps(1023) As Byte
'Result = HidP_GetValueCaps _
 '   (HidP_Input, _
 '    ValueCaps(0), _
 '    Capabilities.NumberInputValueCaps, _
  '   PreparsedData)
    '为了使用次数据,需将字节数组复制到结构数组中
'Call DisplayResultOfAPICall("HidP_GetValueCaps")

'End Sub

'关闭设备
'将前面API函数所占用的资源释放掉
Private Sub Shutdown()
Result = CloseHandle _
    (HidDevice)
Call DisplayResultOfAPICall("CloseHandle (HidDevice)")
Result = SetupDiDestroyDeviceInfoList _
    (DeviceInfoSet)
Call DisplayResultOfAPICall("DestroyDeviceInfoList")
Result = HidD_FreePreparsedData _
    (PreparsedData)
Call DisplayResultOfAPICall("HidD_FreePreparsedData")
End Sub


'写数据到外围设备
Private Sub WriteDevice(ByRef pData As Byte, ByVal BytesNum As Integer)
'传送数据
Dim count As Integer
'Dim NumberOfBytesRead As Long
'Dim NumberOfBytesToSend As Long
Dim NumberOfBytesWritten As Long
'Dim ReadBuffer() As Byte
'Dim SendBuffer() As Byte
'Dim SendData() As Byte
'这个SendBuffer数组从0开始,所以要减去一个字节
'ReDim SendBuffer(BytesNum)
'ReDim SendData(BytesNum)
'SendData(0) = pData
'SendData(0) = 0
'SendBuffer(0) = 0
'下一个字节就是相关的数据
'For Count = 0 To BytesNum
    'SendBuffer(Count) = SendData(Count)
'Next Count
NumberOfBytesWritten = 0
'writeflie函数送出报告给设备
'返回值 : 成功与失败
'需要有createfile函数返回的设备的句柄
'CLng()转为长精度
Result = WriteFile _
    (HidDevice, _
    pData, _
    CLng(BytesNum), _
    NumberOfBytesWritten, _
    0)
Call DisplayResultOfAPICall("WriteFile")
lstResults.AddItem " 输出的报告长度 = " & BytesNum
lstResults.AddItem " 写的字节数 = " & NumberOfBytesWritten
lstResults.AddItem " Report ID: " & pData
'lstResults.AddItem " Report Data:"
'For Count = 1 To UBound(SendBuffer)
      'lstResults.AddItem " " & Hex$(SendBuffer(Count))
'Next Count
End Sub


'读外围设备发送过来的数据
Private Sub ReadDevice(ByVal BytesNum As Integer)
Dim count
Dim NumberOfBytesRead As Long
'声明给报告用的缓冲区,字节0是报告ID
Dim ReadBuffer() As Byte
Dim UBoundReadBuffer As Integer
Dim ByteValue As String
'ReDim ReadBuffer(Capabilities.InputReportByteLength - 1)
'ReadFile函数
'返回值:在ReadBuffer的报告描述符
'需求:由CreateFile函数返回的设备句柄
'CLng()转为长精度
ReDim ReadBuffer(BytesNum)
Result = ReadFile _
    (HidDevice, _
    ReadBuffer(0), _
    CLng(BytesNum), _
    NumberOfBytesRead, _
    0)

If ReadBuffer(0) <> 0 Then
    If ShowHex.Value = 0 Then Rec_Dat.Text = Rec_Dat.Text & ReadBuffer(0) & Chr(32) 'Chr(32)为空格
    If ShowHex.Value = 1 Then
       'For count = 0 To UBound(ReadBuffer)
         If Len(Hex$(ReadBuffer(count))) < 2 Then
            ByteValue = "0" & Hex$(ReadBuffer(0))
         Else
            ByteValue = Hex$(ReadBuffer(0))
         End If
         Rec_Dat.Text = Rec_Dat.Text & ByteValue & Chr(32) 'Chr(32)为空格
         'Next count
    End If
    If ReadBuffer(0) = 128 Then
        Key1.BackColor = RGB(0, 255, 0)
        Key2.BackColor = RGB(255, 0, 0)
     ElseIf ReadBuffer(0) = 64 Then
        Key1.BackColor = RGB(255, 0, 0)
        Key2.BackColor = RGB(0, 255, 0)
    End If
End If
If ReadBuffer(0) = 0 Then
   Key1.BackColor = RGB(255, 0, 0)
   Key2.BackColor = RGB(255, 0, 0)
End If

End Sub

'CTL_CODE代码用于DeviceIoControl__到时再用这个来控制端口1吧
Private Function CTL_CODE(ByVal lDeviceType As Long, ByVal lFunction As Long, ByVal lMethod As Long, ByVal lAccess As Long) As Long
CTL_CODE = (lDeviceType * 2 ^ 16&) Or (lAccess * 2 ^ 14&) Or (lFunction * 2 ^ 2) Or (lMethod)
End Function