canbus.frm

一个实际应用中的CanBus调试程序

            Text6.Visible = True
            Combo7.Visible = True
            Combo8.Visible = True
            Combo9.Visible = True
            Command8.Visible = True
            Command10.Visible = True
            Combo10.Visible = True
            Text12.Visible = True
            Text13.Visible = True
            Check7.Visible = True
       Case 2
            Check1.Visible = True
            Label7(0).Visible = True
            Label7(1).Visible = True
            Text1.Visible = True
            Text2.Visible = True
            Check7.Visible = True
            Command9.Visible = True
       Case 3
            Label7(0).Visible = True
            Label7(1).Visible = True
            Label7(2).Visible = True
            Text1.Visible = True
            Text2.Visible = True
            Check7.Visible = True
            For i = 0 To 35
                Text3(i).Visible = True
            Next
            Label7(3).Visible = True
            Text4.Visible = True
            Text5.Visible = True
       Case 4
            Label7(0).Visible = True
            Label7(1).Visible = True
            Label7(2).Visible = True
            Label7(2).Caption = "                                     上传间隔时间(秒) "
            Text1.Visible = True
            Text2.Visible = True
            Text7.Visible = True
            Text8.Visible = True
            Check7.Visible = True
       Case 5
            Label7(0).Visible = True
            Label7(1).Visible = True
            Label7(2).Visible = True
            Label7(2).Caption = "           切换板地址                       切换周期                   通道数量                   起始通道号 "
            Text1.Visible = True
            Text2.Visible = True
            Text7.Visible = True
            Text8.Visible = True
            Text10.Visible = True
            Text11.Visible = True
            Check7.Visible = True
       Case 6
            Label7(0).Visible = True
            Label7(1).Visible = True
            Label7(2).Visible = True
            Label7(2).Caption = "              相对炉号"
            Text1.Visible = True
            Text2.Visible = True
            Text7.Visible = True
            Command6.Visible = True
            Command7.Visible = True
            Command6.Top = Text7.Top
            Command7.Top = Text7.Top
            Command6.Left = Text7.Left + Text7.Width + 100
            Command7.Left = Command6.Left + Command6.Width + 100
      Case 7
            Label7(0).Visible = True
            Label7(1).Visible = True
            Label7(2).Visible = True
            Label7(2).Caption = "                                          开关量数据 "
            Text1.Visible = True
            Text2.Visible = True
            Text7.Visible = True
            Text8.Visible = True
            Check7.Visible = True
End Select
End Sub

Private Sub Combo6_Click()
Combo6_Change
End Sub

Private Sub Command1_Click()
If Trim(Command1.Caption) = "打开串口" Then
    If Option2.Value = True Then
        MSComm1.InputMode = comInputModeBinary
    Else
        MSComm1.InputMode = comInputModeText
    End If
    Command1.Caption = "关闭串口"
    MSComm1.CommPort = Mid(Trim(Combo1.Text), 4, 1)
    MSComm1.Settings = Trim(Combo2.Text) + "," + Mid(Trim(Combo3.Text), 1, 1) + "," + Trim(Combo4.Text) + "," + Trim(Combo5.Text)
    MSComm1.PortOpen = True
    MSComm1.SThreshold = 1
    MSComm1.RThreshold = 1
    MSComm1.InBufferCount = 0
    MSComm1.OutBufferCount = 0

Else
    Command1.Caption = "打开串口"
    MSComm1.PortOpen = False
End If
'1．CommPort:设置或返回串行端口号,其取值范围为1～16,缺省为1。
'2．Setting:设置或返回串行端口的波特率、奇偶校验位、数据位数、停止位。如:M scomm.Setting="9600,N,8,1"。
'3．PortOpen:打开或关闭串行端口,格式为:Mscomm.PortOpen={TRUE|FALSE}。
'4．InBufferSize:设置或返回接收缓冲区的大小,缺省为1024字节。
'5．InBufferCount:返回接收缓冲区内的等待读取的字节个数,可通过设置该属性为0来清除接收缓冲区。
'6．RThreshold:该属性为一阀值,它确定当接收缓冲区内字节个数达到或超过该值后就产生代码为MSCOMM_EV_RECEIVE的OnComm事件。
'7．InputLen: 设置或返回接收缓冲区内用Input读入的个数。若取0,则INPUT读取整个缓冲区的内容。
'8．Input: 该属性表示从接收缓冲区返回并移走一串字符。
'9．OutBufferSize:设置或返回发送缓冲区,缺省为512字节。
'10．OutBufferCounter:返回发送缓冲区内等待发送的字符数,可用来清空缓冲区。
'11．Output:向发送缓冲区传送一字符串。
'12．EOFEnable:若置TRUE,则当输入中出现EOF,就停止输入并产生OnComm事件。
'13．Handshaking:设置并返回硬件握手协议。用于异步通信的速度匹配。'
'Handshaking 是指内部通信协议，通过该协议，数据从硬件端口传输到接收缓冲区。当一个数据字符到达串行端口，通信设备就把它移到接收缓冲区以使程序可以读它。如果没有接受缓冲区，程序需要直接从硬件读取每一个字符，这很可能会造成数据丢失，因为字符到达的速度可以非常快。握手协议保证在缓冲区过载时数据不会丢失，缓冲区过载为数据到达端口太快而使通信设备来不及将它移到接收缓冲区。
'如果在通信过程中发生错误或事件 , 就会引发OnComm事件并且改变属性值, 由CommEvent属性代码反映错误类型, 在通信程序的设计中可根据该属性值来执行不同的操作, 以下是部分属性常数值及其含义:
'1．ComEvSend: 其值为1,发送缓冲区的内容少于SThreshold指定的值。
'2．ComEvReceive: 其值为2,接收缓冲区内字符数达到 RThreshold 值,该事件在缓冲区中数据被移走前将持续产生。
'3．ComEventFrame: 其值为1004,硬件检测到帧错误。
'4．ComEventRxOver: 其值为1008,接收缓冲区溢出。
'5．ComEventTxFull: 其值为1010,发送缓冲区溢出。
'6．ComEventRxParity: 其值为1009,奇偶校验。
'7．ComEvEOF: 其值为7,接收数据中出现文件结束(ASCII 码为 26)字符
End Sub

Private Sub Command10_Click()
    MSComm1.Output = "{003" + Trim(Text1.Text) & "6" & Trim(Text2.Text) & "}"
End Sub

Private Sub Command2_Click()
 Dim address1 As Integer
 On Error GoTo errorflag
 Bcc = 0
 For i = 0 To 35
     Text3(i).BackColor = &H80000005
     If Len(Trim(Text3(i).Text)) > 0 Then
         address1 = i
         If Option4.Value = True Then
            If Check5.Value = 1 Then
                Bcc = Bcc + Asc(Trim(Text3(i).Text))
            Else
                Bcc = Bcc + Trim(Text3(i).Text)
            End If
         End If
         If Option5.Value = True Then
            If i > 0 Then
                If Check5.Value = 1 Then
                    Bcc = Bcc Xor Asc(Trim(Text3(i).Text))
                Else
                    Bcc = Bcc Xor Trim(Text3(i).Text)
                End If
            End If
         End If
     Else
        Exit For
     End If
 Next
     Bcc = Hex(Bcc Mod 256)
     If Len(Bcc) < 2 Then
        Bcc = Trim("0" + Trim(Bcc))
        Text3(address1 + 1).BackColor = &H80000018
        Text3(address1 + 1).Text = Asc(Mid(Bcc, 1, 2))
        Text3(address1 + 2).BackColor = &HC0C0FF
        Text3(address1 + 2).Text = 13
     Else
       Bcc = "0" + Trim(Mid(Bcc, 1, 1)) + "0" + Trim(Mid(Bcc, 2, 1))
       Text3(address1 + 1).BackColor = &H80000018
       Text3(address1 + 1).Text = Asc(Mid(Bcc, 2, 1))
       Text3(address1 + 2).BackColor = &H80000018
       Text3(address1 + 2).Text = Asc(Mid(Bcc, 4, 1))
       Text3(address1 + 3).BackColor = &HC0C0FF
       Text3(address1 + 3).Text = 13
     End If
     
Exit Sub
errorflag:
         MsgBox "出错，错误号：" & Err & ",错误：" & Error, 64, "提示"
End Sub

Private Sub Command3_Click()
Me.Caption = ""
Dim sendhead, sendstring As String
On Error GoTo errorflag
             If MSComm1.PortOpen = False Then
                Command1.Value = True
                Command1.Caption = "关闭串口"
             End If
            MSComm1.OutBufferCount = 0              '清空发送缓冲区
            MSComm1.InBufferCount = 0               '清空接收缓冲区
    sendhead = "{"
    If Check3.Value = 1 Then
            For i = 0 To 35
                If Len(Trim(Text3(i).Text)) > 0 Then
                     If Check5.Value = 1 Then
                           If Trim(Text3(i).Text) = "00" Then
                               sendstring = sendstring + Chr(Text3(i).Text)
                           Else
                               sendstring = sendstring + HextoStr(UCase(Trim(Text3(i).Text)))
                           End If
                     Else
                          sendstring = sendstring + Chr$(Val(Trim(Text3(i).Text)))
                     End If
                End If
            Next
            Bcc = sendstring
            GoTo flag1
    End If
    Select Case Trim(Combo6.Text)
           Case 1
               sendstring = sendstring + "1" + Trim(Text2.Text)
               If Val(Trim(Text4.Text)) > 0 And (Val(Trim(Text5.Text))) > 0 Then
                    sendstring = sendstring + Chr$(Val(Trim(Text4.Text))) + Chr$(Val(Trim(Text5.Text)))
               Else
                    MsgBox "请输入设备返回字符串."
                    Exit Sub
               End If
               sendstring = sendstring + Trim(Text6.Text) + Trim(Combo9.Text) + Trim(Combo10.Text)
               For i = 0 To 35
                   If Len(Trim(Text3(i).Text)) > 0 Then
                       If Check5.Value = 1 Then
                           sendstring = sendstring + HextoStr(UCase(Trim(Text3(i).Text)))
                       Else
                           sendstring = sendstring + Chr$(Val(Trim(Text3(i).Text)))
                       End If
                   End If
               Next
           Case 2
               sendstring = sendstring + "2" + Trim(Text2.Text) + Trim(Str(Check1.Value))
           Case 3
                sendstring = sendstring + "3" + Trim(Text2.Text)
                sendstring = sendstring + Chr$(Val(Trim(Text4.Text))) + Chr$(Val(Trim(Text5.Text)))
                For i = 0 To 35
                   If Len(Trim(Text3(i).Text)) > 0 Then
                       If Check5.Value = 1 Then
                           sendstring = sendstring + HextoStr(UCase(Trim(Text3(i).Text)))
                       Else
                           sendstring = sendstring + Chr$(Val(Trim(Text3(i).Text)))
                       End If
                   End If
               Next
           Case 4
               sendstring = sendstring + Trim(Text1.Text) & "4" & Trim(Text8.Text)
               sendstring = sendhead + "004" + sendstring
               GoTo timeflag
           Case 5
               sendstring = sendstring + "5" + Trim(Text10.Text) + Trim(Text8.Text) + "1" + Trim(Text11.Text) + Trim(Text7.Text)
           Case 7
               sendstring = sendstring + Trim(Text1.Text) & "7" & Trim(Text8.Text)
               sendstring = sendhead + "005" + sendstring
               GoTo timeflag
    End Select

            sendstring = sendhead + Format(Str(Len(sendstring)), "000") + Trim(Text1.Text) + sendstring
timeflag:
            sendstring = sendstring + "|"
            Bcc = 0
            For i = 1 To Len(sendstring)
                Bcc = Bcc + Asc(Mid$(sendstring, i, 1))
            Next
            Bcc = Bcc Mod 256
            If Len(Hex(Bcc)) = 2 Then
                Bcc = sendstring + Hex(Bcc) + Chr$(125)
            Else
                Bcc = sendstring + "0" + Hex(Bcc) + Chr$(125)
            End If
flag1:
             'If MSComm1.PortOpen = False Then
             '   Command1.Value = True
             '   Command1.Caption = "关闭串口"
             'End If
            'MSComm1.OutBufferCount = 0              '清空发送缓冲区
            'MSComm1.InBufferCount = 0               '清空接收缓冲区
            'Bcc = Chr$(2) + "011R03000" + Chr$(3) + "DC" + Chr$(13)        '
            'Bcc = "#0184" + Chr(13)
            'Bcc = "@01DO0195" + Chr$(13)  '!0182
            'LB_CMD = Chr$(2) + lb_rd + Chr$(3) + Hex(Bcc) + Chr$(13)
            'MDIForm1.MSComm1.RThreshold = 0
            'MDIForm1.MSComm1.Output = LB_CMD
            'If Len(Hex$(Val(lb_xjlh))) < 2 Then
            'lb_ml = "@0" + LTrim$(Hex$(Str$(lb_xjlh))) + "DI"
            'Else
            'lb_ml = "@" + LTrim$(Hex$(Str$(lb_xjlh))) + "DI"
            'End If
            MSComm1.Output = Bcc
           Text9.Text = "发送字符串为：  " + Bcc + "   包含（" + Str(Len(Bcc)) + " ）个字符."
           If Check3.Value = 1 Then
              Dim dt(4) As Integer
              delay (0.05)
              ssstr = MSComm1.Input
              If InStr(1, ssstr, ",") <> 0 Then
                WZ = InStr(1, ssstr, ",")
                valuestr = Mid$(ssstr, WZ + 1, 50)
                lengthstr = Len(valuestr)
                TempStrgd = ""
                TempStrcl = ""
                    j = 0
                    For i = 1 To 4
                        dd = Mid$(valuestr, j + i, 1)
                        If Asc(dd) >= 65 And Asc(dd) <= 70 Then
                            dt(i) = Asc(dd) - 55
                        Else
                            dt(i) = Val(dd)
                        End If
                    Next
                    If dt(1) > 8 Then
                       dt(1) = dt(1) - 16
                    End If
                    TempStrcl = dt(1) * 4096 + dt(2) * 256 + dt(3) * 16 + dt(4)
                    If TempStrcl > 32767 Then
                       TempStrcl = TempStrcl - 65536
                    End If
                    List1.AddItem TempStrcl
            End If
         End If
Exit Sub
errorflag:
         MsgBox "出错，错误号：" & Err & ",错误：" & Error, 64, "提示"
End Sub

Private Sub Command4_Click()
On Error GoTo errorflag
   For i = 0 To 35
       If Len(Trim(Text3(i).Text)) > 0 Then
          If (Asc(Mid(Trim(Text3(i).Text), 1, 1)) >= 65 And Asc(Mid(Trim(Text3(i).Text), 1, 1)) <= 70) Or ((Asc(Mid(Trim(Text3(i).Text), 2, 1)) >= 65 And Asc(Mid(Trim(Text3(i).Text), 2, 1)) <= 70)) Then
               MsgBox "已经为十六进制数."
               Exit Sub
          End If
       End If
   Next
    For i = 0 To 35
          If Len(Trim(Text3(i).Text)) > 0 Then
                Text3(i).Text = Hex(Trim(Text3(i).Text))
                If Len(Trim(Text3(i).Text)) < 2 Then
                    Text3(i).Text = Trim("0" + Trim(Text3(i).Text))
                End If
          End If
   Next
   Exit Sub
errorflag:
   MsgBox "出错，错误号：" & Err & ",错误：" & Error, 64, "提示"
End Sub

Private Sub Command5_Click()
On Error GoTo errorflag
    For i = 0 To 35
          If Len(Trim(Text3(i).Text)) > 0 Then
                Text3(i).Text = Asc(HextoStr(Trim(Text3(i).Text)))
                If Len(Trim(Text3(i).Text)) < 2 Then
                    Text3(i).Text = Trim("0" + Trim(Text3(i).Text))
                End If
          End If
   Next
   Exit Sub
errorflag:
   MsgBox "出错，错误号：" & Err & ",错误：" & Error, 64, "提示"
End Sub

Private Sub Command6_Click()
        Adodc3.RecordSource = "select * from 配置表 where 对应炉号='" & Trim(Text7.Text) & "'"
        Adodc3.Refresh
        Adodc3.Recordset.AddNew
        Adodc3.Recordset.Fields("接口编号") = Trim(Text1.Text)
        Adodc3.Recordset.Fields("设备编号") = Trim(Text2.Text)
        Adodc3.Recordset.Fields("对应炉号") = Trim(Text7.Text)
        Adodc3.Recordset.Update
        Adodc3.RecordSource = "select * from 配置表 order by 对应炉号"
        Adodc3.Refresh
        List1.Clear
        List1.AddItem "配置已经保存! 当前有 " & Adodc3.Recordset.RecordCount & " 条记录："
        For i = 0 To Adodc3.Recordset.RecordCount - 1
            List1.AddItem Adodc3.Recordset.Fields("接口编号") & "   " & Adodc3.Recordset.Fields("设备编号") & "   " & Adodc3.Recordset.Fields("对应炉号")