module2.bas

一个水情自动测报系统的接收例程

Attribute VB_Name = "Module2"
Option Explicit
Public Const jiexian = 20
Public Const riqijiexian = 30 '天

Public Sub return1(ByVal inchar As Byte, ByVal ddd As Integer)
On Error Resume Next

Select Case imm(ddd)

Case 0
imm(ddd) = 1
inx(ddd, 1) = inchar
Exit Sub

Case 1
If pd1(inchar) Then
imm(ddd) = 2
inx(ddd, 2) = inchar
If Not pd3(inx(ddd, 1), inx(ddd, 2), 4, ddd) Then '不接收此站
imm(ddd) = 1
inx(ddd, 1) = inx(ddd, 2)
Exit Sub
End If
Else
imm(ddd) = 0
Exit Sub
End If

Case 2
If pd2(inchar) <> 0 Then '@1
  If pd2(inchar) = 1 Then '@2
     Rflx(ddd) = 1 '一般数据
      If pd4(inx(ddd, 1), inx(ddd, 2), inchar, 4, ddd) Then '@3
      imm(ddd) = 3
      inx(ddd, 3) = inchar
      Else '不接收此站'@3

       If pd1(inchar) Then '@4
         imm(ddd) = 2
         inx(ddd, 1) = inx(ddd, 2)
         inx(ddd, 2) = inchar
          If Not pd3(inx(ddd, 1), inx(ddd, 2), 4, ddd) Then '不接收此站'@5
          imm(ddd) = 1
          inx(ddd, 1) = inx(ddd, 2)
          End If '@5
       Else '@4
         imm(ddd) = 0
       End If '@4

     End If '@3
  Else '@2
     Rflx(ddd) = 2 '人工置数参数
  End If '@2



 Else '@1
  If pd1(inchar) Then
     imm(ddd) = 2
     inx(ddd, 1) = inx(ddd, 2)
     inx(ddd, 2) = inchar
  Else
     imm(ddd) = 0
  End If
End If '@1

Case 3
inx(ddd, 4) = inchar
If Rflx(ddd) = 1 Then
Call R_Date(inx(ddd, 1), inx(ddd, 2), inx(ddd, 3), inx(ddd, 4))
imm(ddd) = 0
Rflx(ddd) = 0
Else
imm(ddd) = imm(ddd) + 1
End If


Case Else
'inx(imm + 1) = inchar
'imm = imm + 1
'If ((imm = 11) And (Rflx = 2)) Then
'Call Man_Maker
imm(ddd) = 0
Rflx(ddd) = 0
'End If

End Select
End Sub

Public Sub return2(ByVal inchar As Byte, ByVal ddd As Integer)
On Error Resume Next

Select Case imm2(ddd)
Case 0
If inchar = QUHAO Then
imm2(ddd) = 1
inx2(ddd, 1) = inchar
End If
Exit Sub

Case 1
If pd1(inchar) Then
imm2(ddd) = 2
inx2(ddd, 2) = inchar
Else
If inchar = QUHAO Then
imm2(ddd) = 1
inx2(ddd, 1) = inchar
End If
End If
Exit Sub

Case 2
If pd1(inchar) Then
 inx2(ddd, 3) = inchar
 imm2(ddd) = 3
 If Not pd3(inx2(ddd, 2), inx2(ddd, 3), 8, ddd) Then '不接收此站
   If inx2(ddd, 2) = QUHAO Then
    inx2(ddd, 1) = inx2(ddd, 2)
    inx2(ddd, 2) = inx2(ddd, 3)
    imm2(ddd) = 2
   Else
    If inx2(ddd, 3) = QUHAO Then
    imm2(ddd) = 1
    inx2(ddd, 1) = inx2(ddd, 3)
    Else
    imm(ddd) = 0
    End If
   End If
  Exit Sub
 End If
Else
 If inchar = QUHAO Then
  imm2(ddd) = 1
  inx2(ddd, 1) = inchar
  Else
  imm2(ddd) = 0
 End If
End If
Exit Sub

Case 3
If pd1(inchar) Then
 If inchar = &HCA Or inchar = &HD1 Or inchar = &HFF Then
  imm2(ddd) = 4
  inx2(ddd, 4) = inchar
 Else
   If inx2(ddd, 2) = QUHAO Then
    imm2(ddd) = 3
    inx2(ddd, 1) = inx2(ddd, 2)
    inx2(ddd, 2) = inx2(ddd, 3)
    inx2(ddd, 3) = inx2(ddd, 4)
   Else
    If inx2(ddd, 3) = QUHAO Then
     imm2(ddd) = 2
     inx2(ddd, 1) = inx2(ddd, 3)
     inx2(ddd, 2) = inx2(ddd, 4)
    Else
     If inchar = QUHAO Then
     imm2(ddd) = 1
     inx2(ddd, 1) = inchar
     Else
     imm2(ddd) = 0
     End If
    End If
   End If
 End If
Else
 If inchar = QUHAO Then
  imm2(ddd) = 1
  inx2(ddd, 1) = inchar
 Else
 imm2(ddd) = 0
 End If
End If
Exit Sub

Case 4
If pd1(inchar) Then
 imm2(ddd) = 5
 inx2(ddd, 5) = inchar
Else
 If inchar = QUHAO Then
 imm2(ddd) = 1
 inx2(ddd, 1) = inchar
 Else
 imm2(ddd) = 0
 End If
End If
Exit Sub

Case 5
If pd1(inchar) Then
 imm2(ddd) = 6
 inx2(ddd, 6) = inchar
Else
 If inchar = QUHAO Then
 imm2(ddd) = 1
 inx2(ddd, 1) = inchar
 Else
 imm2(ddd) = 0
 End If
End If
Exit Sub

Case 6
If pd1(inchar) Then
 imm2(ddd) = 7
 inx2(ddd, 7) = inchar
Else
 If inchar = QUHAO Then
 imm2(ddd) = 1
 inx2(ddd, 1) = inchar
 Else
 imm2(ddd) = 0
 End If
End If
Exit Sub

Case 7
If inchar = (inx2(ddd, 1) Xor _
             inx2(ddd, 2) Xor _
             inx2(ddd, 3) Xor _
             inx2(ddd, 4) Xor _
             inx2(ddd, 5) Xor _
             inx2(ddd, 6) Xor _
             inx2(ddd, 7)) Then
Call R_Date2(inx2(ddd, 2), inx2(ddd, 3), inx2(ddd, 4), inx2(ddd, 5), inx2(ddd, 6), inx2(ddd, 7), ddd)
imm2(ddd) = 0
Else
imm2(ddd) = 0
End If
Case Else
imm(ddd) = 0
End Select
End Sub

Public Sub return3(ByVal inchar As Byte, ByVal ddd As Integer)
Select Case imm3(ddd)
Case 0
If inchar = SMART_QUHAO Then
inx3(ddd, 0) = SMART_QUHAO
imm3(ddd) = 1
End If
Exit Sub

Case 1, 2
inx3(ddd, imm3(ddd)) = inchar
imm3(ddd) = imm3(ddd) + 1
Exit Sub

Case 3
If inchar = ZHEN Then
inx3(ddd, 3) = inchar
imm3(ddd) = 4
Else
If inchar = SMART_QUHAO Then
imm3(ddd) = 1
inx2(ddd, 1) = inchar
Else
imm3(ddd) = 0
End If
End If
Exit Sub


Case Is >= 4
inx3(ddd, imm3(ddd)) = inchar
imm3(ddd) = imm3(ddd) + 1

If imm3(ddd) = inx3(ddd, 4) + 4 + 2 + 1 Then '长度+校验2字节够了
Dim xxx(0 To 17) As Byte
Dim i As Integer
For i = 0 To 17
xxx(i) = inx3(ddd, i)
Next i
'If GetCrc(inx3(ddd, 0), 18) = 1 Then '校验正确处理程序
If GetCrc(xxx(0), 18) = 1 Then '校验正确处理程序
'Max.MSComm1.RThreshold = 0 '关中断
Call r_date3(ddd)
'Max.MSComm1.RThreshold = 1 '开中断
End If
imm3(ddd) = 0
End If
Exit Sub


Case Else
End Select
End Sub


Public Sub r_date3(ByVal ddd As Integer)
Dim addr As Integer
Dim total As Single
Dim t As Date
Dim st, ST1 As String
Dim tabl As Recordset
Dim d(0 To 3) As Byte

addr = inx3(ddd, 2)
If addr < 0 Or addr > 255 Then Exit Sub
If Not pd5(addr, &HC, 16, ddd) Then Exit Sub

d(3) = inx3(ddd, 12)
d(2) = inx3(ddd, 13)
d(1) = inx3(ddd, 14)
d(0) = inx3(ddd, 15)
CopyMem total, d(0), 4
If total < 0 Then Exit Sub

'If inx3(8) <= 0 Or inx3(8) > 12 Then Exit Sub '月
'If inx3(9) <= 0 Or inx3(9) > 31 Then Exit Sub '日
'If inx3(10) < 0 Or inx3(10) >= 24 Then Exit Sub '时
'If inx3(11) < 0 Or inx3(11) >= 60 Then Exit Sub '分

't = DateSerial(inx3(7), inx3(8), inx3(9)) + TimeSerial(inx3(10), inx3(11), 0)
t = Now()

p_date.addr = addr
p_date.character = &HC '雨量
p_date.day = day(Now())
p_date.hour = hour(Now())
p_date.min = Minute(Now())
p_date.mon = Month(Now())
p_date.total = CInt(total)
Open App.Path & "\" & old_file For Binary As #12
Put #12, FileLen(App.Path & "\" & old_file) + 1, p_date
Close #12


Total_Rain = Total_Rain + 1
ST1 = Format$(addr, "000") + "号站 " + "雨量" + " " + Format$(total, "000.0") + " " + Format$(t, "yyyy-mm-dd hh:mm:ss")
Call Write_Act(addr, ST1, &HC)


ST1 = "SELECT * from 雨量排除 WHERE 雨量排除 = " & CStr(total)
Set tabl = New Recordset
tabl.Open ST1, DB1, adOpenStatic, adLockOptimistic

If tabl.BOF Then
ST1 = "INSERT INTO 雨量 (站号,雨量,时间) VALUES (" & _
                  CStr(addr) & "," & _
                  CStr(total) & "," & _
                  zhong_time_symbol & Format$(t, "yyyy-mm-dd hh:mm:ss") & zhong_time_symbol & ")"
DB1.Execute ST1
Max.Winsock1.SendData "1"
End If

st = "INSERT INTO 原始数据 (站号,数值,时间,物理量) VALUES (" & _
                  CStr(addr) & "," & _
                  CStr(total) & "," & _
                  zhong_time_symbol & Format$(t, "yyyy-mm-dd hh:mm:ss") & zhong_time_symbol & "," & _
                  "'雨量')"
DB1.Execute st
Open App.Path & file_Path & Format$(addr, "000") & ".txt" For Append As #2
Print #2, Format$(addr, "000") & " " & Format$(total, "000.0") & " " & Format$(t, "yyyy-mm-dd hh:mm:ss")
Close #2



Call Change_StatusBar
Set tabl = Nothing
End Sub

Public Sub R_Date2(ByVal i2 As Byte, _
                   ByVal i3 As Byte, _