mod.bas

串口调试相关源码

Attribute VB_Name = "Modtotu"
Dim sum_chk%                    '存储校验和
Dim sql$
Dim rs As ADODB.Recordset



'一个数据包中的变量
Public SOH As Byte              '数据包头  1个字节   ABH
Public EID As String            '设备号    3个字节
Public FID As Byte              '功能号    1个字节
                                '0建档,1传成绩,2查询数据,3应答,4掉线命令,5返回时间,6返回名次
Public CID As String            '卡号      5个字节
Public DID As String            '脚环号    5个字节
Public TIM As String            '时间      8个字节
Public CHK As Byte              '校验字节  1个字节   前面的数据和并求反
Public GRD As String            '名次      4个字节
Public SPD As String            '速度      8个字节   米/分
Public DIS As String            '距离      8个字节   米
Public CTM As String            '耗时      8个字节   秒
Public YNE As Byte              '是否结束  1个字节   0结束,1继续发送下一条记录
Public RID As String            '记录编号  3个字节



'对功能号的各种情况的解释
Const SD As Byte = &H0          '建档
Const SR As Byte = &H1          '上传成绩
Const RR As Byte = &H2          '查询成绩
Const AK As Byte = &H3          '应答 确认
Const HD As Byte = &H4          '掉线命令
Const RT As Byte = &H5          '返回时间
Const RG As Byte = &H6          '返回名次
Const QT As Byte = &H5          '请求时间（to tu）




'不同数据包的接收的二进制数组
Public GE_byte() As Byte      '通用             50个字节

Public SD_byte(0 To 39) As Byte     '建档             40个字节
Public SR_byte(0 To 39) As Byte     '上传成绩         40个字节
Public RR_byte(0 To 17) As Byte     '查询成绩         18个字节
Public AK_byte(0 To 8) As Byte      '应答             9个字节
Public HD_byte(0 To 8) As Byte      '掉线命令         9个字节
Public RT_byte(0 To 18) As Byte     '返回时间         19个字节
Public RG_byte(0 To 46) As Byte     '返回名次/记录    47个字节
Public CO_byte(0 To 5) As Byte      '计算机上确认     6个字节（to tu）
Public QT_byte(0 To 8) As Byte      '请求时间         9个字节（to tu）


'十六进制转换为十进制
Public Function hex_10(ByVal hhex As String) As Long
    Const M As Integer = 16
    Dim hh As Long
    Dim i As Long
    Dim j As Long
    Dim lin As Integer
    j = Len(hhex)
    For i = 1 To Len(hhex)
       Select Case Mid$(hhex, i, 1)
              Case "A"
                    lin = 10
              Case "B"
                    lin = 11
              Case "C"
                    lin = 12
              Case "D"
                    lin = 13
              Case "E"
                    lin = 14
              Case "F"
                    lin = 15
              Case Else
                    lin = Val(Mid$(hhex, i, 1))
       End Select
       j = j - 1
      hh = hh + M ^ j * lin
    Next i
    hex_10 = hh
End Function
Public Sub read()
    
       a = Form1.MSComm1(m_id).InBufferCount    '收到多少个数据
       ReDim GE_byte(a) As Byte
       
       GE_byte = Form1.MSComm1(m_id).Input
       
       For i = 0 To a - 1  '显示出来
           Form1.Text4.Text = Form1.Text4.Text + Chr(GE_byte(i))
         
           Form1.Text8.Text = Form1.Text8.Text + Hex(CInt(GE_byte(i))) + Space(1)
           If CInt(GE_byte(i)) = 13 Then
              Form1.Text8.Text = Form1.Text8.Text + vbCrLf
           End If
       Next i
       
       Form1.Text4.SelStart = Len(Form1.Text4.Text)
       Form1.Text8.SelStart = Len(Form1.Text8.Text):
sum_chk = 0   '校验和清零
    If UBound(GE_byte) > 7 Then    '判断读出的字符串是不是超过6个字节
       Select Case GE_byte(7)
              Case QT
                       '请求时间
                   For i = 0 To 7
                       QT_byte(i) = GE_byte(i)
                       sum_chk = sum_chk + GE_byte(i)
                   Next i
                    '进行校验
                    
                    mod_chk = sum_chk Mod 256
                    
                    If mod_chk = Not (GE_byte(8)) Then
                       Call QT_opt
                    End If
       
              Case SD       '建档
                           '**********************************************************************
                             'ABH|主机设备号|功能号|电子脚环号|日期和时间|通用脚环号|校验
                             ' 1 |     6    |   1  |    10    |    6     |     15   |  1
                             '共40个字节
                           '*********************************************************************
                   For i = 0 To 38
                       SD_byte(i) = GE_byte(i)
                       sum_chk = sum_chk + GE_byte(i)
                   Next i
                    '进行校验
                    
                    mod_chk = sum_chk Mod 256
                    
                    If mod_chk = Not (GE_byte(39)) Then
                       Call SD_opt
                    End If
                   
              Case SR       '上传成绩
                           '**********************************************************************
                             'ABH|主机设备号|功能号|电子脚环号|日期和时间|通用脚环号|校验
                             ' 1 |     6    |   1  |    10    |    6     |     15   |  1
                             '共40个字节
                           '*********************************************************************

                   For i = 0 To 38
                       SR_byte(i) = GE_byte(i)
                       sum_chk = sum_chk + GE_byte(i)
                   Next i
                    '进行校验
                    mod_chk = sum_chk Mod 256
                    
                    If mod_chk = Not (GE_byte(39)) Then
                       Call SR_opt
                    End If
              Case RR       '查询成绩
                   For i = 0 To 17
                       RR_byte(i) = GE_byte(i)
                       sum_chk = sum_chk + GE_byte(i)
                   Next i
                    '进行校验
                    sum_chk = sum_chk - GE_byte(17)
                    mod_chk = sum_chk Mod 256
                    
                    If mod_chk = Not (GE_byte(17)) Then
                       Call RR_opt
                    End If
                    
              Case AK       '应答
                   For i = 0 To 8
                       AK_byte(i) = GE_byte(i)
                       sum_chk = sum_chk + GE_byte(i)
                   Next i
                    '进行校验
                    sum_chk = sum_chk - GE_byte(8)
                    mod_chk = sum_chk Mod 256
                    
                    If mod_chk = Not (GE_byte(8)) Then
                       Call AK_opt
                    End If
              Case HD       '掉线
                   For i = 0 To 8
                       RR_byte(i) = GE_byte(i)
                       sum_chk = sum_chk + GE_byte(i)
                   Next i
                    '进行校验
                    sum_chk = sum_chk - GE_byte(8)
                    mod_chk = sum_chk Mod 256
                    
                    If mod_chk = Not (GE_byte(8)) Then
                       Call HD_opt
                    End If
       End Select
       
    End If
err:

End Sub

Sub QT_opt()
    'MsgBox "请求时间"
    SOH = &HAB
      '****************************************************************************************************
    FID = &H5 '功能编号为5 返回时间
''''''    TIM = Date$ + Space(1) + Time$
'''''    '得到日期和时间
'''''    d1 = CInt(Year(Date)) \ 256         '和d1组成年
'''''    d2 = CInt(Year(Date)) Mod 256
'''''    d3 = CInt(Month(Date))              '月
'''''    d4 = CInt(Day(Date))                '日
'''''    d5 = 32                             '一个空格
'''''    d6 = CInt(Hour(Time))               '小时
'''''    d7 = CInt(Minute(Time))             '分钟
'''''    d8 = CInt(Second(Time))             '秒
'''''
'''''    CHK = ((CInt(SOH) + e1 + e2 + e3 + CInt(FID) + d1 + d2 + d3 + d4 + d5 + d6 + d7 + d8) Mod 256)
'''''
'''''    CHK = Not CHK

    Dim e1, e2, e3 As Byte
    '把服务器的计算机名称转换成三个字节 在这个地方名称用8为数字做为名称但不大于256*256*256
    e1 = CLng(computername) \ 65536
    e2 = (CLng(computername) Mod 65536) \ 256
    e3 = (CLng(computername) Mod 65536) Mod 256
    Dim d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, d11, d12, d13 As Byte
    '年
    d1 = CInt(Mid(CStr(Year(Date)), 3, 1)) + &H30
    d2 = CInt(Right(CStr(Year(Date)), 1)) + &H30
    '月
    If Len(CStr(Month(Date))) < 2 Then