pubfunc.bas

一个功能比较完善的远程抄表软件

    'SendCode 0
    'temVal = Delay(10, 5)
    SendCode UserAddr               '发地址码
    PORTC1_VAL = PORTC1_VAL And &HFE  'PC0置低
    PORTC1_VAL = PORTC1_VAL Or &H2    'PC1置高

    'temVal = OutBit(PortC_1, PORTC1_VAL)
    '总线一线制
    '修改日期2001.1.15
    PORTC1_VAL = PORTC1_VAL And &HF7
    temVal = OutBit(PortC_1, PORTC1_VAL)
    temVal = Delay(1, 5)
    PORTC1_VAL = PORTC1_VAL Or &H8
    temVal = OutBit(PortC_1, PORTC1_VAL)
    pubTimer1.Enabled = False
    pubTimerCount1 = 0
    pubTimer1.Interval = 100
    pubTimer1.Enabled = True
    Do While pubTimerCount1 <= 10
        temVal = chkPort(PortB_2)
        If (temVal And bRead2) <> 0 Then
            pubTimer1.Enabled = False
            pubTimerCount1 = 0
            temVal = Delay(1, 15)
            PORTC1_VAL = PORTC1_VAL And &HFE      'PC0置0
            PORTC1_VAL = PORTC1_VAL And &HFD    'PC1置0
            PORTC1_VAL = PORTC1_VAL And &HF7
            temVal = OutBit(PortC_1, PORTC1_VAL)
            temVal = Delay(10, 5)
            PORTC1_VAL = PORTC1_VAL Or &H8
            temVal = OutBit(PortC_1, PORTC1_VAL)
            CloseUserGate = True
            'SendCode 0
            Exit Function
        End If
        DoEvents
    Loop
    
    pubTimer1.Enabled = False
    pubTimerCount1 = 0
    CloseUserGate = False
            PORTC1_VAL = PORTC1_VAL And &HFE      'PC0置0
            PORTC1_VAL = PORTC1_VAL And &HFD    'PC1置0
            temVal = OutBit(PortC_1, PORTC1_VAL)
            temVal = Delay(10, 5)
            SendCode 0

End Function

Sub Code(UserAddr As Integer)
Dim i As Integer
Dim Number As Integer
Dim Third As Integer
Dim rem1 As Integer
Dim quot1 As Integer
    
    Third = 1

    Number = UserAddr
    Addr(0) = 0
    Addr(1) = 0
    i = 0
    Do While Number > 0
        quot1 = Number \ 3
        rem1 = Number - 3 * quot1
        
        If (rem1 = 2) Then
            Addr(1) = Addr(1) + Third * (2 ^ i)
            Third = 1
        Else
            Addr(0) = Addr(0) + rem1 * (2 ^ i)
        End If
        Number = quot1
        i = i + 1
    Loop
End Sub

Sub Init8255()
    X = OutBit(Ctrl_1, &H80)
    X = OutBit(Ctrl_2, &H9B)
    
    X = OutBit(PortB_1, &HFF)
    If gCollectType = 0 Then
        PORTC1_VAL = &H0
    Else
        PORTC1_VAL = &H4
    End If
    '总线一线制
    '修改日期2001.1.15
    PORTC1_VAL = PORTC1_VAL Or &H8
    
    X = OutBit(PortC_1, PORTC1_VAL)
End Sub
Function OpenUserGate(UserAddr) As Boolean
'发地址码--PortC_1的PC0置高(开)
'发地址码--PortC_1的PC0置低(关)
'检查:打开网关---查看PortB_2PB0的有无正脉冲到来

    SendCode UserAddr               '发地址码
    PORTC1_VAL = PORTC1_VAL Or &H1      'PC0置高
    PORTC1_VAL = PORTC1_VAL And &HFD    'PC1置低
    temVal = OutBit(PortC_1, PORTC1_VAL)
    pubTimer1.Enabled = False
    pubTimerCount1 = 0
    pubTimer1.Interval = 1000
    pubTimer1.Enabled = True
    Do While pubTimerCount1 <= 2
        temVal = chkPort(PortB_2)
        If (temVal And bRead2) <> 0 Then
            pubTimer1.Enabled = False
            pubTimerCount1 = 0
            temVal = Delay(1, 15)
            PORTC1_VAL = PORTC1_VAL And &HFE      'PC0置0
            PORTC1_VAL = PORTC1_VAL And &HFD    'PC1置0
            temVal = OutBit(PortC_1, PORTC1_VAL)
            temVal = Delay(10, 5)

            OpenUserGate = True
            SendCode 0
            Exit Function
        End If
        DoEvents
    Loop
    
    pubTimer1.Enabled = False
    pubTimerCount1 = 0
    OpenUserGate = False
    PORTC1_VAL = PORTC1_VAL And &HFE      'PC0置0
    PORTC1_VAL = PORTC1_VAL And &HFD    'PC1置0
    temVal = OutBit(PortC_1, PORTC1_VAL)
    temVal = Delay(10, 5)
End Function

Sub SendCode(ByVal UserAddr As Integer)
Dim portA_val As Integer
Dim portB_val As Integer
Dim TE_5026_CLOSE  As Integer
Dim TE_5026_OPEN  As Integer

    TE_5026_CLOSE = &H80
    TE_5026_OPEN = &HEF
    
    Code (UserAddr)
    X = OutBit(PortB_1, TE_5026_CLOSE)       '控制5026的TE使能端，关断地址信号在总线上的传输：1-关断，0-打开
    'x = OutBit(PortB_1, &HFF)       '使三态缓冲器的控制端置高
    portA_val = Addr(0) And &H1F Or TE_5026_CLOSE
    X = OutBit(PortA_1, portA_val)    '地址为130时，00011011  138时,00010010
    portB_val = Addr(1) And &H1F
    X = OutBit(PortB_1, portB_val)    'CBB总线上有采集板的地址   130---00000100   138时,00001000
    portA_val = portA_val And TE_5026_OPEN
    X = OutBit(PortA_1, portA_val)
End Sub

Sub openCard(ByVal cardAddr As Integer)
Dim portA_val As Integer
Dim portB_val As Integer
Dim TE_5026_CLOSE  As Integer
Dim TE_5026_OPEN  As Integer

    TE_5026_CLOSE = &H80
    TE_5026_OPEN = &H7F
    
    Code (cardAddr)
    X = OutBit(PortA_1, TE_5026_CLOSE)       '控制5026的TE使能端，关断地址信号在总线上的传输：1-关断，0-打开
    'x = OutBit(PortA_1, 0)       '控制5026的TE使能端，关断地址信号在总线上的传输：1-关断，0-打开
    
    portA_val = Addr(0) And &H1F Or TE_5026_CLOSE
    'portA_val = Addr(0) And &H1F And TE_5026_OPEN
    X = OutBit(PortA_1, portA_val)    '地址为130时，00011011  138时,00010010
    
    portB_val = Addr(1) And &H1F
    X = OutBit(PortB_1, portB_val)    'CBB总线上有采集板的地址   130---00000100   138时,00001000
    
    portA_val = portA_val And TE_5026_OPEN
    X = OutBit(PortA_1, portA_val)

End Sub
Sub closeCard()
Dim portA_val As Integer
Dim portB_val As Integer
Dim TE_5026_CLOSE  As Integer
Dim TE_5026_OPEN  As Integer

    TE_5026_CLOSE = &H80
    TE_5026_OPEN = &HEF
    
    X = OutBit(PortA_1, TE_5026_CLOSE)       '控制5026的TE使能端，关断地址信号在总线上的传输：1-关断，0-打开
End Sub
Sub SoundAlert(curAlertType)
'警型:
'   8---老人救护
'   2---防盗
'   1---煤气泄漏
'   0---盗水,盗气
Dim AlertLife As Integer
Dim AlertRob As Integer
Dim AlertGas As Integer
Dim AlertWater As Integer

    AlertLife = &H10
    AlertRob = &H20
    AlertGas = &H40
    AlertWater = &H80
    
    Select Case curAlertType
        Case ALERT_WATER
'status
            AppendStatusInfo "盗水,气报警", icoRED
            SaveLog "盗水,气报警", 1
            PORTC1_VAL = PORTC1_VAL Or AlertWater
        Case ALERT_GAS
'status
            AppendStatusInfo "煤气漏气报警", icoRED
            SaveLog "煤气漏气报警", 1
            PORTC1_VAL = PORTC1_VAL Or AlertGas
        Case ALERT_ROB
'status
            AppendStatusInfo "防盗报警", icoRED
            SaveLog "防盗报警", 1
            PORTC1_VAL = PORTC1_VAL Or AlertRob
        Case ALERT_LIFE
'status
            AppendStatusInfo "", icoRED
            SaveLog "救护报警", 1
            PORTC1_VAL = PORTC1_VAL Or AlertLife
    End Select
    temVal = OutBit(PortC_1, PORTC1_VAL)
    '总线一线制
    '修改日期2001.1.15
    PORTC1_VAL = PORTC1_VAL And &HF7
    temVal = OutBit(PortC_1, PORTC1_VAL)
    temVal = Delay(1, 1)
    PORTC1_VAL = PORTC1_VAL Or &H8
    temVal = OutBit(PortC_1, PORTC1_VAL)
End Sub
Sub MuteAlert(curAlertType As Integer)
'警型:
'   8---老人救护
'   2---防盗
'   1---煤气泄漏
'   0---盗水,盗气
Dim AlertLife As Integer
Dim AlertRob As Integer
Dim AlertGas As Integer
Dim AlertWater As Integer

    AlertLife = &H10
    AlertRob = &H20
    AlertGas = &H40
    AlertWater = &H80
    
    Select Case curAlertType
        Case ALERT_WATER
            PORTC1_VAL = PORTC1_VAL And (Not AlertWater)
        Case ALERT_GAS
            PORTC1_VAL = PORTC1_VAL And (Not AlertGas)
        Case ALERT_ROB
            PORTC1_VAL = PORTC1_VAL And (Not AlertRob)
        Case ALERT_LIFE
            PORTC1_VAL = PORTC1_VAL And (Not AlertLife)
    End Select
    temVal = OutBit(PortC_1, PORTC1_VAL)
    '总线一线制
    '修改日期2001.1.15
    PORTC1_VAL = PORTC1_VAL And &HF7
    temVal = OutBit(PortC_1, PORTC1_VAL)
    temVal = Delay(1, 1)
    PORTC1_VAL = PORTC1_VAL Or &H8
    temVal = OutBit(PortC_1, PORTC1_VAL)
End Sub
Sub CloseBuild(BuildAddr As Integer)
'发地址码--PortC_1的PC1置高(开)
'发地址码--PortC_1的PC1置低(关)
    
    SendCode BuildAddr                   '发地址码
    PORTC1_VAL = PORTC1_VAL And &HFD        'PC1置低
    'temVal = OutBit(PortC_1, PORTC1_VAL)
    'Delay 1, 5
    '总线一线制
    '修改日期2001.1.15
    PORTC1_VAL = PORTC1_VAL And &HF7
    temVal = OutBit(PortC_1, PORTC1_VAL)
    temVal = Delay(1, 5)
    PORTC1_VAL = PORTC1_VAL Or &H8
    temVal = OutBit(PortC_1, PORTC1_VAL)
    'SendCode 0

End Sub

Sub CloseGate(GateAddr As Integer)
'发地址码--PortC_1的PC0置高(开)
'发地址码--PortC_1的PC0置低(关)

    SendCode GateAddr               '发地址码
    PORTC1_VAL = PORTC1_VAL And &HFE      'PC0置低
    'temVal = OutBit(PortC_1, PORTC1_VAL)
    'Delay 1, 5
    '总线一线制
    '修改日期2001.1.15
    PORTC1_VAL = PORTC1_VAL And &HF7
    temVal = OutBit(PortC_1, PORTC1_VAL)
    Delay 1, 5
    PORTC1_VAL = PORTC1_VAL Or &H8
    temVal = OutBit(PortC_1, PORTC1_VAL)
    'SendCode 0

End Sub
Function CollectUserData_pul(curUserID As Integer, curDevID As Integer, curCardAddr As Integer, curDevAddr As Integer) As Integer
'脉冲表采集函数
'返回值:    0---正常采集
'           1---超时无反应
'           2---丢失换表脉冲
'           3---丢失读脉冲(丢失位)
'           4---丢失一表或多表数据
'           5---采集被终止
'           6---错误的用户数据
'           其他---其他错误
Dim temVal As Integer
Dim curGetData As Long
Dim RFlag As Boolean        '读脉冲辅助标志,用于防止重复读取同一个脉冲
Dim CollectDevID As Integer '用户设备数
Dim ReadCount As Integer    '有效读脉冲个数,用于在换表脉冲到来时,判断读脉冲是否检取正确
                                '4位表,当换表脉冲到来时,该值应为4
                                '5位表,当换表脉冲到来时,该值应为5

    RFlag = True
    ReadCount = 0
    CollectDevID = 0
    curGetData = 0
    DData(curDevID) = -1
    
   
'status
    AppendStatusInfo "发送用户" & curUserID & "地址" & UserAddress, icoBLUE
    SaveLog "发送用户" & curUserID & "地址" & UserAddress, 0
    'OpenUser (UserAddress)        '打开当前用户
    openDev curCardAddr, curDevAddr
    
    pubTimerCount1 = 0              '用公共计时器1来作为超时计时器
    pubTimer1.Enabled = False
    pubTimer1.Interval = 1000
    pubTimer1.Enabled = True
    
    
    Do While True                       '进入监控循环
        If CancelCollect Then
            CollectUserData_pul = 5
            'SendCode 0
            Exit Do
        End If
        '超时
        If pubTimerCount1 > 5 Then              '用户超时无反应(>3秒)
'status
            AppendStatusInfo "超时无反应", icoRED
            SaveLog "超时无反应", 1
            pubTimer1.Enabled = False
            pubTimer1.Interval = 0
            pubTimerCount1 = 0
            CollectUserData_pul = 1                     '超时退出
            Exit Do
        End If
        
        '读脉冲
        If chkBit(PortB_2, bRead2, 1, 1) <> 0 Then
            If RFlag Then
                pubTimerCount1 = 0