sendinfor.bas

通过PC机的串口和单片机等嵌入式下位机通信

Attribute VB_Name = "SendInfor"
Public SendingCount As Integer           '正发送信息的总个数
Public SendingCountTh As Integer         '发送数据的第几条
  

Public Minstr(1 To 100) As String
Public Hourstr(1 To 100) As String
Public Daystr(1 To 100) As String
Public Weekstr(1 To 100) As String
Public Monstr(1 To 100) As String
Public Yearstr(1 To 100) As String
Public Censtr(1 To 50) As String
Public Thingstr(1 To 300) As String

Public SendCount(1 To 8) As Integer     '对应的数据的数量
Public Div(1 To 8) As Integer           '记录是否是零个，标志变量
Public Myth(1 To 8) As Byte
'分析信息，准备发送
Public Sub Anlysis()
Dim AllTimeCount As Integer    '时间事件的个数
AllTimeCount = 0

SendingCountTh = 0

For i = 1 To 7
  AllTimeCount = AllTimeCount + KindCount(i)
Next i


'用循环取得要发送的时间和各种事件
For i = 1 To KindCount(1)
  Minstr(i) = Mid(Main.List.List(i), 5, 21)
Next i
For i = 1 To KindCount(2)
  Hourstr(i) = Mid(Main.List.List(KindCount(1) + i), 5, 21)
Next i
For i = 1 To KindCount(3)
  Daystr(i) = Mid(Main.List.List(Add(2) + i), 5, 21)
Next i
For i = 1 To KindCount(4)
  Weekstr(i) = Mid(Main.List.List(Add(3) + i), 5, 21)
Next i
For i = 1 To KindCount(5)
  Monstr(i) = Mid(Main.List.List(Add(4) + i), 5, 21)
Next i
For i = 1 To KindCount(6)
  Yearstr(i) = Mid(Main.List.List(Add(5) + i), 5, 21)
Next i
For i = 1 To KindCount(7)
  Censtr(i) = Mid(Main.List.List(Add(6) + i), 5, 21)
Next i

For i = 1 To Main.List.ListCount - 1
  Thingstr(i) = Mid(Main.List.List(i), 27)
Next i

For i = 1 To 7
  SendCount(i) = KindCount(i)    '要发送事件的数量
Next i
SendCount(8) = Main.List.ListCount - 1

For i = 1 To 7                   '记录有无的标志量
  If SendCount(i) = 0 Then
    Div(i) = 0
  Else
    Div(i) = 1
  End If
Next i

For i = 1 To 7
  If SendCount(i) = 0 Then
    SendCount(i) = 1          '没有也得发送一条
  End If
Next i


For i = 1 To 8
  Myth(i) = 0
Next i

End Sub
'发送数据信息过程
Public Sub Sendinf()
Main.Status.Caption = "信息发送中....."
SendingCountTh = SendingCountTh + 1

Select Case SendingCountTh
  Case 1 To SendCount(1)
    Myth(1) = Myth(1) + 1
    Call SendMin(Minstr(Myth(1)), Myth(1))
    
  Case SendCount(1) + 1 To Adda(2)
    Myth(2) = Myth(2) + 1
    Call SendHour(Hourstr(Myth(2)), Myth(2))
    
  Case Adda(2) + 1 To Adda(3)
    Myth(3) = Myth(3) + 1
    Call SendDay(Daystr(Myth(3)), Myth(3))
    
  Case Adda(3) + 1 To Adda(4)
    Myth(4) = Myth(4) + 1
    Call SendWeek(Weekstr(Myth(4)), Myth(4))
    
  Case Adda(4) + 1 To Adda(5)
    Myth(5) = Myth(5) + 1
    Call SendMon(Monstr(Myth(5)), Myth(5))
    
  Case Adda(5) + 1 To Adda(6)
    Myth(6) = Myth(6) + 1
    Call SendYear(Yearstr(Myth(6)), Myth(6))
    
  Case Adda(6) + 1 To Adda(7)
    Myth(7) = Myth(7) + 1
    Call SendCen(Censtr(Myth(7)), Myth(7))
    
  Case Adda(7) + 1 To Adda(8)
    Myth(8) = Myth(8) + 1
    Call SendThing(Thingstr(Myth(8)))
    
  Case Adda(8) + 1
    Call SendLastCount
End Select

End Sub
'发送分
Public Sub SendMin(mystr As String, Nth As Byte)
Dim bytinf(0 To 10) As Byte
For i = 0 To 10
  bytinf(i) = &HFF
Next i
'bytinf(2) = Nth - 1            '本类中的第几条
'没有记录的特殊处理
If Div(1) = 0 Then
  bytinf(1) = 1
  Call SendinfTo(bytinf())
  Exit Sub
End If
'正常情况
If Nth = 1 Then
  bytinf(1) = 1            '种类,分周期用1
Else
  bytinf(1) = 0
End If

bytinf(3) = ConvertBCD(Val(Right(mystr, 2)))
Call SendinfTo(bytinf())
End Sub
'发送时
Public Sub SendHour(mystr As String, Nth As Byte)
Dim bytinf(0 To 10) As Byte
For i = 0 To 10
  bytinf(i) = &HFF
Next i
bytinf(2) = Nth - 1            '本类中的第几条
'没有记录的特殊处理
If Div(2) = 0 Then
  bytinf(1) = 2
  Call SendinfTo(bytinf())
  Exit Sub
End If
'正常情况
If Nth = 1 Then
  bytinf(1) = 2            '种类,分周期用1
Else
  bytinf(1) = 0
End If
bytinf(3) = ConvertBCD(Val(Right(mystr, 2)))
bytinf(4) = ConvertBCD(Val(Mid(mystr, 17, 2)))
Call SendinfTo(bytinf())
End Sub
'发送天
Public Sub SendDay(mystr As String, Nth As Byte)
Dim bytinf(0 To 10) As Byte
For i = 0 To 10
  bytinf(i) = &HFF
Next i
bytinf(2) = Nth - 1            '本类中的第几条
'没有记录的特殊处理
If Div(3) = 0 Then
  bytinf(1) = 3
  Call SendinfTo(bytinf())
  Exit Sub
End If
'正常情况
If Nth = 1 Then
  bytinf(1) = 3            '种类,分周期用1
Else
  bytinf(1) = 0
End If
bytinf(3) = ConvertBCD(Val(Right(mystr, 2)))
bytinf(4) = ConvertBCD(Val(Mid(mystr, 17, 2)))
bytinf(5) = ConvertBCD(Val(Mid(mystr, 14, 2)))
Call SendinfTo(bytinf())
End Sub
'发送星期
Public Sub SendWeek(mystr As String, Nth As Byte)
Dim bytinf(0 To 10) As Byte
For i = 0 To 10
  bytinf(i) = &HFF
Next i
bytinf(2) = Nth - 1            '本类中的第几条
'没有记录的特殊处理
If Div(4) = 0 Then
  bytinf(1) = 4
  Call SendinfTo(bytinf())
  Exit Sub
End If
'正常情况
If Nth = 1 Then
  bytinf(1) = 4            '种类,分周期用1
Else
  bytinf(1) = 0
End If
bytinf(3) = ConvertBCD(Val(Right(mystr, 2)))
bytinf(4) = ConvertBCD(Val(Mid(mystr, 17, 2)))
bytinf(5) = ConvertBCD(Val(Mid(mystr, 14, 2)))
bytinf(6) = ConvertBCD(Val(Mid(mystr, 12, 1)))
Call SendinfTo(bytinf())
End Sub
'发送月
Public Sub SendMon(mystr As String, Nth As Byte)
Dim bytinf(0 To 10) As Byte
For i = 0 To 10
  bytinf(i) = &HFF
Next i
bytinf(2) = Nth - 1            '本类中的第几条
'没有记录的特殊处理
If Div(5) = 0 Then
  bytinf(1) = 5
  Call SendinfTo(bytinf())
  Exit Sub
End If
'正常情况
If Nth = 1 Then
  bytinf(1) = 5            '种类,分周期用1
Else
  bytinf(1) = 0
End If
bytinf(3) = ConvertBCD(Val(Right(mystr, 2)))
bytinf(4) = ConvertBCD(Val(Mid(mystr, 17, 2)))
bytinf(5) = ConvertBCD(Val(Mid(mystr, 14, 2)))
bytinf(7) = ConvertBCD(Val(Mid(mystr, 9, 2)))
Call SendinfTo(bytinf())
End Sub
'发送年
Public Sub SendYear(mystr As String, Nth As Byte)
Dim bytinf(0 To 10) As Byte
For i = 0 To 10
  bytinf(i) = &HFF
Next i
bytinf(2) = Nth - 1            '本类中的第几条
'没有记录的特殊处理
If Div(6) = 0 Then
  bytinf(1) = 6
  Call SendinfTo(bytinf())
  Exit Sub
End If
'正常情况
If Nth = 1 Then
  bytinf(1) = 6            '种类,分周期用1
Else
  bytinf(1) = 0
End If
bytinf(3) = ConvertBCD(Val(Right(mystr, 2)))
bytinf(4) = ConvertBCD(Val(Mid(mystr, 17, 2)))
bytinf(5) = ConvertBCD(Val(Mid(mystr, 14, 2)))
bytinf(7) = ConvertBCD(Val(Mid(mystr, 9, 2)))
bytinf(8) = ConvertBCD(Val(Mid(mystr, 6, 2)))
Call SendinfTo(bytinf())
End Sub
'发送世纪
Public Sub SendCen(mystr As String, Nth As Byte)
Dim bytinf(0 To 10) As Byte
For i = 0 To 10
  bytinf(i) = &HFF
Next i
bytinf(2) = Nth - 1            '本类中的第几条
'没有记录的特殊处理
If Div(7) = 0 Then
  bytinf(1) = 7
  Call SendinfTo(bytinf())
  Exit Sub
End If
'正常情况
If Nth = 1 Then
  bytinf(1) = 7            '种类,分周期用1
Else
  bytinf(1) = 0
End If
bytinf(3) = ConvertBCD(Val(Right(mystr, 2)))
bytinf(4) = ConvertBCD(Val(Mid(mystr, 17, 2)))
bytinf(5) = ConvertBCD(Val(Mid(mystr, 14, 2)))
bytinf(7) = ConvertBCD(Val(Mid(mystr, 9, 2)))
bytinf(8) = ConvertBCD(Val(Mid(mystr, 6, 2)))
bytinf(9) = ConvertBCD(Val(Mid(mystr, 3, 2)))
Call SendinfTo(bytinf())
End Sub
'发送事件
Public Sub SendThing(mystr As String)
mystr = mystr + Chr(0) + Chr$(&H7C)
Main.MSComm.Output = mystr
End Sub
'发送最后数据
Public Sub SendLastCount()
Dim Lastdata(1 To 11) As Byte
Lastdata(2) = 0
For i = 1 To 7
  Lastdata(2) = Lastdata(2) + SendCount(i)
Next i
Lastdata(1) = &H0
Lastdata(3) = Hex(KindCount(8))
For i = 4 To 10
  If SendCount(i - 3) = 1 And Div(i - 3) = 0 Then
    Lastdata(i) = &H1
  Else
    Lastdata(i) = SendCount(i - 3)
  End If
Next i
Lastdata(11) = &H7C
Main.MSComm.Output = Lastdata
Main.MSComm.PortOpen = False
Main.Status.Caption = "信息发送成功!"
End Sub
'发送
Public Sub SendinfTo(byt() As Byte)
byt(0) = &H1                  '不是结尾则头数是1
byt(2) = SendingCountTh
byt(10) = &H7C                 '最后结尾
Main.MSComm.Output = byt
End Sub
'辅助函数
Private Function Add(n As Integer) As Integer
Dim m As Integer
m = 0
For i = 1 To n
  m = m + KindCount(i)
Next i
Add = m
End Function
Private Function Adda(n As Byte) As Integer
 Dim k As Integer
 k = 0
 For i = 1 To n
   k = k + SendCount(i)
 Next i
 Adda = k
 End Function