form1.frm

周立功USBCANII设备

    
    CAN_BTR0(0) = "BF"
    CAN_BTR0(1) = "31"
    CAN_BTR0(2) = "18"
    CAN_BTR0(3) = "09"
    CAN_BTR0(4) = "04"
    CAN_BTR0(5) = "03"
    CAN_BTR0(6) = "01"
    CAN_BTR0(7) = "00"
    CAN_BTR0(8) = "00"
    CAN_BTR0(9) = "00"
    CAN_BTR1(0) = "FF"
    CAN_BTR1(1) = "1C"
    CAN_BTR1(2) = "1C"
    CAN_BTR1(3) = "1C"
    CAN_BTR1(4) = "1C"
    CAN_BTR1(5) = "1C"
    CAN_BTR1(6) = "1C"
    CAN_BTR1(7) = "1C"
    CAN_BTR1(8) = "16"
    CAN_BTR1(9) = "14"
    Combo8.ListIndex = 3
    Combo9.ListIndex = 0
    'Text4.Text = ""
    'Text11.Text = Hex(Len(Text4.Text) / 2)
    'For i = 0 To 3
    '    If Len(Text11.Text) <> 4 Then
    '        Text11.Text = "0" + Text11.Text
    '    Else
    '        Exit For
    '   End If
    'Next
    'Text10.Text = CRC16(Text4.Text)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If m_connect = 1 Then
        m_connect = 0
        VCI_CloseDevice m_devtype, m_devind
    End If
End Sub



'Private Sub Text4_KeyUp(KeyCode As Integer, Shift As Integer)
Private Sub Text4_Change()
    If (Len(Text4.Text) Mod 2) = 0 Then
        
        If Check4.Value = 1 Then
            Text11.Text = Hex((Len(Text4.Text) / 2) + 4)
        Else
            Text11.Text = Hex(Len(Text4.Text) / 2)
        End If
        For i = 0 To 3
            If Len(Text11.Text) <> 4 Then
                Text11.Text = "0" + Text11.Text
            Else
                Exit For
            End If
        Next
        user_str = Text11.Text + Text4.Text 'left(,len(Text4.Text)
        If Check4.Value = 1 Then
            Text10.Text = CRC16(user_str)
        Else
            If Len(Text4.Text) > 1 Then
            Text10.Text = CRC16(Text4.Text)
            Else
            Text10.Text = "FFFF"
            End If
        End If
        If Text10.Text = "0000" Then
            Text10.Text = "FFFF"
        End If
        user_str = user_str + Right(Text10.Text, 2) + Left(Text10.Text, 2)
        user_str_length = Len(user_str)
    End If
End Sub

Private Sub Timer1_Timer()
    Timer1.Enabled = False
    Dim ErrInfo As VCI_ERR_INFO
    
    If m_connect = 0 Then
        Timer1.Enabled = True
        Exit Sub
    End If

    Dim length As Long
    Dim frameinfo(49) As VCI_CAN_OBJ
    Dim str As String
    Dim can_id As Long
    
    length = VCI_Receive(m_devtype, m_devind, m_cannum, frameinfo(0), 50, 10)
    If length <= 0 Then
        VCI_ReadErrInfo m_devtype, m_devind, m_cannum, ErrInfo '注意：如果没有读到数据则必须调用此函数来读取出当前的错误码，
                                                               '千万不能省略这一步（即使你可能不想知道错误码是什么）
        Timer1.Enabled = True
        Exit Sub
    End If
    
    For i = 0 To length - 1
        str = "----收-"
        If frameinfo(i).TimeFlag = 0 Then
            tmpstr = "--无--"
        Else
            tmpstr = "0x" + Hex(frameinfo(i).TimeStamp)
            For j = 0 To 9
                If Len(tmpstr) <> 9 Then
                    tmpstr = tmpstr + " "
                Else
                    Exit For
                End If
            Next
        End If
        str = str + tmpstr
        can_id = frameinfo(i).ID
        If can_id > 268435455 Then
            If can_id Mod 2 = 0 Then
            can_id = can_id / 2
            tmpstr = "  0x" + Hex(can_id) + "0" + "     "
            Else
            can_id = can_id / 2
            tmpstr = "  0x" + Hex(can_id) + "8" + "     "
            End If
        Else
            tmpstr = "  0x" + Hex(can_id * 8) + "     "
        End If
        
        str = str + tmpstr
       
        'str = str + "  帧类型:"
        If frameinfo(i).ExternFlag = 0 Then
            tmpstr = "标准帧   "
        Else
            tmpstr = "扩展帧   "
        End If
        str = str + tmpstr
        
         'str = str + "  帧格式:"
        If frameinfo(i).RemoteFlag = 0 Then
            tmpstr = "数据帧   "
        Else
            tmpstr = "远程帧   "
        End If
        str = str + tmpstr
               
        'List1.AddItem str, List1.ListCount
        If frameinfo(i).RemoteFlag = 0 Then
            'str = " "
            If frameinfo(i).DataLen > 8 Then
                frameinfo(i).DataLen = 8
            End If
            
            tmpstr = "    " + Hex(frameinfo(i).DataLen) + "     "
            str = str + tmpstr
            
            For j = 0 To frameinfo(i).DataLen - 1
                If frameinfo(i).data(j) < 16 Then
                    tmpstr = "0" + Hex(frameinfo(i).data(j)) ' + " "
                Else
                    tmpstr = Hex(frameinfo(i).data(j)) ' + " "
                End If
                str = str + tmpstr
            Next
            List1.AddItem str, List1.ListIndex = List1.ListCount
            
        End If
    Next
    Timer1.Enabled = True
End Sub

Private Function CAN_Send()
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Function
    End If
    
    Dim SendType, frameformat, frametype As Byte
    Dim ID As Long
    Dim data(7) As Byte
    Dim frameinfo As VCI_CAN_OBJ
    Dim str As String
    Dim ID2 As String
    Dim ID3 As String
    Dim frame_len As Byte
    Select Case Combo9.ListIndex
        Case 0
            SendType = Combo3.ListIndex
            frameformat = Combo5.ListIndex
            frametype = Combo4.ListIndex
            str = "&H"
            str = str + Text1.Text
            ID = Val(str) / 8
            str = Text4.Text
            StrData = " "
            i = 0
            For i = 0 To 7
               StrData = Left(str, 2)
               If Len(StrData) < 2 Then
                  Exit For
               End If
               str = Right(str, Len(str) - 2)
               data(i) = Val("&H" + StrData)
            Next
        Case 1
            SendType = Combo3.ListIndex
            frameformat = Combo5.ListIndex
            frametype = Combo4.ListIndex
            
            If user_str_length > 16 Then
                str = Left(user_str, 14)
                str = str + CRC8(str)
                frame_len = 14
            Else
                str = Left(user_str, 16)
                frame_len = 16
            End If
            
            StrData = " "
            i = 0
            For i = 0 To 7
                StrData = Left(str, 2)
                If Len(StrData) < 2 Then
                   Exit For
                End If
                str = Right(str, Len(str) - 2)
                data(i) = Val("&H" + StrData)
            Next
            
            ID2 = Hex(frame_serial_num)
            If Len(ID2) <> 2 Then
                ID2 = "0" + ID2
            End If
            If Len(user_str) > frame_len Then
                user_str = Right(user_str, Len(user_str) - 14)
                ID3 = "80"
                frame_serial_num = frame_serial_num + 1
                If Check2.Value = 1 Then
                    Timer2.Interval = Val(Text9.Text)
                    Timer2.Enabled = True
                End If
            Else
                ID3 = "00"
                frame_serial_num = 0
                user_str = Text11.Text + Text4.Text + Right(Text10.Text, 2) + Left(Text10.Text, 2)
                Timer2.Enabled = False
            End If
            Text1.Text = Text8.Text + Text7.Text + ID2 + ID3
            str = "&H"
            str = str + Text1.Text
            ID = Val(str) / 8
        Case 2
    End Select
    frameinfo.DataLen = i
    frameinfo.ExternFlag = frametype
    frameinfo.RemoteFlag = frameformat
    frameinfo.SendType = SendType
    frameinfo.ID = ID
    For j = 0 To i - 1
        frameinfo.data(j) = data(j)
    Next
    
    
    If VCI_Transmit(m_devtype, m_devind, m_cannum, frameinfo, 1) <> 1 Then
        MsgBox ("发送数据失败")
    Else
        'List1.AddItem "发送数据成功", List1.ListIndex = List1.ListCount
        
        str = "-发----"
        If frameinfo.TimeFlag = 0 Then
            tmpstr = "----无-----"
        Else
            tmpstr = "0x" + Hex(frameinfo.TimeStamp) + " "
        End If
        str = str + tmpstr
        
        str = str + "0x" + Text1.Text + "     " '帧ID
        
        str = str + Combo4.Text + "   " '帧类型
        
        str = str + Combo5.Text + "   " '帧格式
               
        'List1.AddItem str, List1.ListCount
        If frameinfo.RemoteFlag = 0 Then
            'str = " "
            If frameinfo.DataLen > 8 Then
                frameinfo.DataLen = 8
            End If
            
            tmpstr = "    " + Hex(frameinfo.DataLen) + "     "
            str = str + tmpstr
            
            For j = 0 To frameinfo.DataLen - 1
                If frameinfo.data(j) < 16 Then
                    tmpstr = "0" + Hex(frameinfo.data(j)) ' + " "
                Else
                    tmpstr = Hex(frameinfo.data(j)) ' + " "
                End If
                str = str + tmpstr
            Next
            List1.AddItem str, List1.ListIndex = List1.ListCount
            
        End If
    End If
End Function

Function GetCRC8(Index As Long) As Byte
    GetCRC8 = Choose(Index + 1, _
    &H0, &H5E, &HBC, &HE2, &H61, &H3F, &HDD, &H83, &HC2, &H9C, &H7E, &H20, &HA3, &HFD, &H1F, &H41, _
    &H9D, &HC3, &H21, &H7F, &HFC, &HA2, &H40, &H1E, &H5F, &H1, &HE3, &HBD, &H3E, &H60, &H82, &HDC, _
    &H23, &H7D, &H9F, &HC1, &H42, &H1C, &HFE, &HA0, &HE1, &HBF, &H5D, &H3, &H80, &HDE, &H3C, &H62, _
    &HBE, &HE0, &H2, &H5C, &HDF, &H81, &H63, &H3D, &H7C, &H22, &HC0, &H9E, &H1D, &H43, &HA1, &HFF, _
    &H46, &H18, &HFA, &HA4, &H27, &H79, &H9B, &HC5, &H84, &HDA, &H38, &H66, &HE5, &HBB, &H59, &H7, _
    &HDB, &H85, &H67, &H39, &HBA, &HE4, &H6, &H58, &H19, &H47, &HA5, &HFB, &H78, &H26, &HC4, &H9A, _
    &H65, &H3B, &HD9, &H87, &H4, &H5A, &HB8, &HE6, &HA7, &HF9, &H1B, &H45, &HC6, &H98, &H7A, &H24, _
    &HF8, &HA6, &H44, &H1A, &H99, &HC7, &H25, &H7B, &H3A, &H64, &H86, &HD8, &H5B, &H5, &HE7, &HB9, _
    &H8C, &HD2, &H30, &H6E, &HED, &HB3, &H51, &HF, &H4E, &H10, &HF2, &HAC, &H2F, &H71, &H93, &HCD, _
    &H11, &H4F, &HAD, &HF3, &H70, &H2E, &HCC, &H92, &HD3, &H8D, &H6F, &H31, &HB2, &HEC, &HE, &H50, _
    &HAF, &HF1, &H13, &H4D, &HCE, &H90, &H72, &H2C, &H6D, &H33, &HD1, &H8F, &HC, &H52, &HB0, &HEE, _
    &H32, &H6C, &H8E, &HD0, &H53, &HD, &HEF, &HB1, &HF0, &HAE, &H4C, &H12, &H91, &HCF, &H2D, &H73, _
    &HCA, &H94, &H76, &H28, &HAB, &HF5, &H17, &H49, &H8, &H56, &HB4, &HEA, &H69, &H37, &HD5, &H8B, _
    &H57, &H9, &HEB, &HB5, &H36, &H68, &H8A, &HD4, &H95, &HCB, &H29, &H77, &HF4, &HAA, &H48, &H16, _
    &HE9, &HB7, &H55, &HB, &H88, &HD6, &H34, &H6A, &H2B, &H75, &H97, &HC9, &H4A, &H14, &HF6, &HA8, _
    &H74, &H2A, &HC8, &H96, &H15, &H4B, &HA9, &HF7, &HB6, &HE8, &HA, &H54, &HD7, &H89, &H6B, &H35)
End Function



Private Function CRC8(StrData As String) As String
    Dim CRC_Temp As Byte
    Dim CRC_Index As Long
    Dim bdata() As Byte
    Dim stmp As String
    ReDim bdata(Len(StrData) / 2 - 1) As Byte
    For N = 0 To Len(StrData) / 2 - 1
          bdata(N) = CInt("&H" & Mid(StrData, 2 * N + 1, 2))
    Next N
    Dim i As Long
    CRC_Temp = 0
    For i = LBound(bdata) To UBound(bdata)
        CRC_Index = CRC_Temp Xor bdata(i)
        CRC_Temp = GetCRC8(CRC_Index)
    Next
    stmp = CStr(Hex(CRC_Temp))
    If Len(stmp) = 1 Then
    stmp = "0" + stmp
    End If
    CRC8 = stmp
End Function

Private Function CRC16(StrData As String) As String
      Dim CRC16Hi As Byte
      Dim CRC16Lo As Byte
      Dim crcclidata As String
      Dim stmp As String
      CRC16Hi = &H0
      CRC16Lo = &H0
      Dim i As Integer
      Dim iIndex As Long
      Dim data() As Byte
      ReDim data(Len(StrData) / 2 - 1) As Byte
      For N = 0 To Len(StrData) / 2 - 1
          data(N) = CInt("&H" & Mid(StrData, 2 * N + 1, 2))
      Next N
      
      For i = 0 To UBound(data)
        iIndex = CRC16Lo Xor data(i)
        CRC16Lo = CRC16Hi Xor GetCRCLo(iIndex)        '低位处理
        CRC16Hi = GetCRCHi(iIndex)                    '高位处理
      Next i
      Dim ReturnData(1) As Byte
      ReturnData(0) = CRC16Hi        'CRC高位
      ReturnData(1) = CRC16Lo        'CRC低位
'      CRC16 = ReturnData
    stmp = CStr(Hex(ReturnData(1)))
    If Len(stmp) = 1 Then
      stmp = "0" & stmp
    End If
    crcclidata = stmp
    stmp = CStr(Hex(ReturnData(0)))
    If Len(stmp) = 1 Then
      stmp = "0" & stmp
    End If
    crcclidata = crcclidata & stmp
    CRC16 = crcclidata
End Function

    'CRC低位字节值表
Function GetCRCLo(Ind As Long) As Byte
    GetCRCLo = Choose(Ind + 1, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
    &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40)
End Function

    'CRC高位字节值表
Function GetCRCHi(Ind As Long) As Byte
    GetCRCHi = Choose(Ind + 1, &H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7, &H5, &HC5, &HC4, &H4, &HCC, &HC, &HD, &HCD, &HF, &HCF, &HCE, &HE, &HA, &HCA, &HCB, &HB, &HC9, &H9, &H8, &HC8, &HD8, &H18, &H19, &HD9, &H1B, &HDB, &HDA, &H1A, &H1E, &HDE, &HDF, &H1F, &HDD, &H1D, &H1C, &HDC, &H14, &HD4, &HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3, &H11, &HD1, &HD0, &H10, &HF0, &H30, &H31, &HF1, &H33, &HF3, &HF2, &H32, &H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, &H3C, &HFC, &HFD, &H3D, &HFF, &H3F, &H3E, &HFE, &HFA, &H3A, &H3B, &HFB, &H39, &HF9, &HF8, &H38, &H28, &HE8, &HE9, &H29, &HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF, &H2D, &HED, &HEC, &H2C, &HE4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26, &H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, &HA0, &H60, _
    &H61, &HA1, &H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, &HA5, &H65, &H64, &HA4, &H6C, &HAC, &HAD, &H6D, &HAF, &H6F, &H6E, &HAE, &HAA, &H6A, &H6B, &HAB, &H69, &HA9, &HA8, &H68, &H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA, &HBE, &H7E, &H7F, &HBF, &H7D, &HBD, &HBC, &H7C, &HB4, &H74, &H75, &HB5, &H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, &H70, &HB0, &H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, &H96, &H56, &H57, &H97, &H55, &H95, &H94, &H54, &H9C, &H5C, &H5D, &H9D, &H5F, &H9F, &H9E, &H5E, &H5A, &H9A, &H9B, &H5B, &H99, &H59, &H58, &H98, &H88, &H48, &H49, &H89, &H4B, &H8B, &H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C, &H44, &H84, &H85, &H45, &H87, &H47, &H46, &H86, &H82, &H42, &H43, &H83, &H41, &H81, &H80, &H40)
End Function

Private Sub Timer2_Timer()
    CAN_Send
End Sub