form1.frm

用VB做的

         Width           =   855
      End
      Begin VB.Label Label9 
         Caption         =   "端口："
         Height          =   255
         Left            =   240
         TabIndex        =   10
         Top             =   360
         Width           =   615
      End
   End
   Begin VB.Frame Frame6 
      Caption         =   "信息"
      Height          =   2535
      Left            =   240
      TabIndex        =   33
      Top             =   3960
      Width           =   8655
      Begin VB.ListBox List1 
         Height          =   2205
         Left            =   120
         TabIndex        =   34
         Top             =   240
         Width           =   8415
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim m_devtype As Long
Dim m_connect As Byte
Dim m_devind As Long


Private Sub Command1_Click()
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    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
    
    SendType = Combo3.ListIndex
    frameformat = Combo5.ListIndex
    frametype = Combo4.ListIndex
    str = "&H"
    str = str + Text1.Text
    ID = Val(str)
    str = Text4.Text
    strdata = Left(str, 2)
    i = 0
    While Len(strdata) > 0 And i < 8
       data(i) = Val("&H" + strdata)
       i = i + 1
       str = Right(str, Len(str) - 3)
       strdata = Left(str, 2)
    Wend
    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, 0, frameinfo, 1) <> 1 Then
        MsgBox ("发送数据失败")
    Else
        List1.AddItem "发送数据成功", List1.ListCount
    End If

End Sub

Private Sub Command2_Click()
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    If VCI_StartCAN(m_devtype, m_devind, 0) <> 1 Then
        MsgBox ("启动CAN错误")
    Else
        List1.AddItem "启动CAN成功", List1.ListCount
    End If
End Sub

Private Sub Command3_Click()
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    If VCI_ResetCAN(m_devtype, m_devind, 0) <> 1 Then
        MsgBox ("复位CAN错误")
   Else
        List1.AddItem "复位CAN成功", List1.ListCount
    End If

End Sub

Private Sub Command4_Click()
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    
    Dim i As Long
    i = Combo1.ListIndex
    If i <> -1 Then
        If VCI_SetReference(m_devtype, m_devind, 0, 1, i) <> 1 Then
            MsgBox ("更改CAN波特率错误")
        Else
            List1.AddItem "更改CAN波特率成功", List1.ListCount
        End If
    End If

End Sub

Private Sub Command5_Click(Index As Integer)
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    
    Dim i As Long
    i = Combo2.ListIndex
    If i <> -1 Then
        i = i + 1
        If VCI_SetReference(m_devtype, m_devind, 0, 3, i) <> 1 Then
            MsgBox ("更改232波特率错误")
        Else
            List1.AddItem "更改232波特率成功", List1.ListCount
        End If
    End If

End Sub

Private Sub Command6_Click()
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    
    Dim addr As Byte
    Dim info(13) As Byte
    Dim str As String
    
    addr = Val(Text2.Text)
    If addr > 0 And addr < 5 Then
        info(0) = addr
        If VCI_GetReference(m_devtype, m_devind, 0, 1, info(0)) <> 1 Then
            MsgBox ("读取滤波器参数错误")
        Else
            str = "滤波器参数信息:"
            For j = 0 To 13
                tmpstr = Hex(info(j)) + " "
                str = str + tmpstr
            Next
            List1.AddItem str, List1.ListCount
        End If
    End If
    
End Sub

Private Sub Command7_Click()
    If m_connect = 0 Then
        MsgBox ("请先打开端口")
        Exit Sub
    End If
    
    Dim data(11) As Byte
    Dim str As String
    
    str = Text3.Text
    i = 0
    strdata = "aa"
    While Len(strdata) > 0 And i < 12
       strdata = Left(str, 2)
       str = Right(str, Len(str) - 3)
       data(i) = Val("&H" + strdata)
       i = i + 1
    Wend
    If i < 11 Then
        MsgBox ("数据长度不够")
        Exit Sub
    End If
    
    If VCI_SetReference(m_devtype, m_devind, 0, 2, data(0)) <> 1 Then
        MsgBox ("设置滤波器参数错误")
    Else
        List1.AddItem "设置滤波器参数成功", List1.ListCount
    End If
End Sub

Private Sub Connect_Click()
    Dim port As Long
    Dim baud As Long
    
    If m_connect = 1 Then
        m_connect = 0
        Connect.Caption = "连接"
        VCI_CloseDevice m_devtype, m_devind
        Exit Sub
    End If
        
    If Combo_port.ListIndex <> -1 And Combo_Baud.ListIndex <> -1 Then
        port = Combo_port.ListIndex
        baud = Combo_Baud.ItemData(Combo_Baud.ListIndex)
        If VCI_OpenDevice(m_devtype, port, baud) <> 1 Then
            MsgBox ("打开端口错误")
        Else
            m_connect = 1
            m_devind = port
            Connect.Caption = "断开"
        End If
    End If
    
End Sub

Private Sub Form_Load()
    m_devtype = 6 'CAN232类型号
    m_connect = 0
    Combo3.ListIndex = 2
    Combo4.ListIndex = 0
    Combo5.ListIndex = 0
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 Timer1_Timer()
    Timer1.Enabled = False
    
    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
    
    length = VCI_Receive(m_devtype, m_devind, 0, frameinfo(0), 50, 10)
    If length < 0 Then
        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)
        End If
        str = str + tmpstr
        tmpstr = "  帧ID:0x" + Hex(frameinfo(i).ID)
        str = str + tmpstr
        str = str + "  帧格式:"
        If frameinfo(i).RemoteFlag = 0 Then
            tmpstr = "数据帧 "
        Else
            tmpstr = "远程帧 "
        End If
        str = str + tmpstr
        str = str + "  帧类型:"
        If frameinfo(i).ExternFlag = 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
            For j = 0 To frameinfo(i).DataLen - 1
                tmpstr = Hex(frameinfo(i).data(j)) + " "
                str = str + tmpstr
            Next
            List1.AddItem str, List1.ListCount
        End If
    Next
    Timer1.Enabled = True
End Sub