mdimain.frm

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

                
                mnuBaseSet.Enabled = True
                mnuOPSetup.Enabled = True
                mnuGateSet.Enabled = True
                mnuBuildSet.Enabled = True
                mnuUserSet.Enabled = True
                mnuPrice.Enabled = True
                mnuSuper.Enabled = True
                mnuNetError.Enabled = True
                mnuAddrTribute.Enabled = True
                mnuUserOperate.Enabled = True
        Exit Sub
    End If

Dim rcOP As Recordset

    Set rcOP = dbCbb.OpenRecordset("OPMap", dbOpenSnapshot)
    If Not rcOP.EOF Then
        rcOP.FindFirst "trim(ID)=""" + Trim(curOP) + """"
        If Not rcOP.NoMatch Then
            If rcOP!checkNet = 1 Or curOP = "SUPER" Then
                mnuChkAll.Enabled = True
                mnuChkGate.Enabled = True
                mnuChkBBus.Enabled = True
                mnuGateProcess.Enabled = True
                mnuSafeWallProcess.Enabled = True
                mnuNetError.Enabled = True
                mnuUserOperate.Enabled = True
            End If
            If rcOP!DataCollect = 1 Or curOP = "SUPER" Then
                mnuCollectAll.Enabled = True
                mnuCollectSome.Enabled = True
                mnuNetError.Enabled = True
                mnuCardData.Enabled = True
            End If
            If rcOP!DataQuery = 1 Or curOP = "SUPER" Then
                mnuQuery.Enabled = True
                mnuNetError.Enabled = True
            End If
            If rcOP!DataEdit = 1 Or curOP = "SUPER" Then
                mnuClear.Enabled = True
            End If
            If rcOP!monAlert = 1 Or curOP = "SUPER" Then
                mnuOpenAlert = True
                mnuShutAlert = True
                mnuBrowAlert = True
                mnuNetError.Enabled = True
            End If
            If rcOP!OPSet = 1 Or curOP = "SUPER" Then
                mnuOPSetup.Enabled = True
            End If
            If rcOP!SysSet = 1 Or curOP = "SUPER" Then
                mnuBaseSet.Enabled = True
                mnuGateSet.Enabled = True
                mnuBuildSet.Enabled = True
                mnuUserSet.Enabled = True
                mnuPrice.Enabled = True
                mnuAddrTribute.Enabled = True
            End If
        End If
    End If
End Sub

' 1998.4.11 0905 last changed ( 4 bit version )
Sub procDataClct()
    mnuDataCollect.Enabled = True
End Sub
Sub procMoney()
    mnuPrice.Enabled = True
    'mnuBrowseAll.Enabled = True
    'mnuCollectOne.Enabled = True
End Sub
Sub procNetChk()
    mnuChkAll.Enabled = True
    mnuChkBBus.Enabled = True
    mnuChkGate.Enabled = True
    'mnuChkBuild.Enabled = True
    mnuGateProcess.Enabled = True
    mnuSafeWallProcess.Enabled = True
End Sub
Sub procAlert()
    mnuOpenAlert.Enabled = True
    mnuBrowAlert.Enabled = True
    'cmdStartAlert.Enabled = True
End Sub
Sub procNetSet()
    'mnuNetSet.Enabled = True
    mnuUserSet.Enabled = True
    mnuPrice.Enabled = True
    'mnuOPType.Enabled = True
End Sub
Sub procDataBrow()
    'mnuBrowseAll.Enabled = True
    'mnuQueryOne.Enabled = True
End Sub

Sub OPLoadEnv(logOPType As Integer)
    Dim i As Integer
    For i = 0 To LogOn.OPLevel(logOPType).OPRightSum - 1
        Select Case LogOn.OPLevel(logOPType).OPLevelRight(i)
            Case 0:
                procDataClct
            Case 1:
                procMoney
            Case 2:
                procNetChk
            Case 3:
                procAlert
            Case 4:
                procNetSet
            Case 5:
                procDataBrow
        End Select
    Next i
    If logOPType = 0 Then
        mnuClear.Enabled = True
    End If
End Sub
Sub beSafe()
'    pnlLife.BackColor = Green
 '   pnlRob.BackColor = Green
  '  pnlgas.BackColor = Green
End Sub
Sub alrtLife()
Dim res As Integer
    pnlLife.BackColor = RED
'    res = soundAlert(AlertLife)
End Sub
Sub alrtRob()
Dim res As Integer
    pnlRob.BackColor = RED
'    res = soundAlert(Alertrob)
End Sub
Sub loadAlertPanel()
    pnlLife.FontSize = 10
    pnlLife.BackColor = SYS_COLOR
    pnlLife.ForeColor = DARKGRAY
    
    pnlRob.BackColor = SYS_COLOR
    pnlRob.ForeColor = DARKGRAY
    pnlRob.FontSize = 10
    
    pnlGas.BackColor = SYS_COLOR
    pnlGas.ForeColor = DARKGRAY
    pnlGas.FontSize = 10
    
    pnlWater.BackColor = SYS_COLOR
    pnlWater.ForeColor = DARKGRAY
    pnlWater.FontSize = 10
End Sub
Sub alrtWater()
Dim res As Integer
    pnlWater.BackColor = RED
'    res = soundAlert(Alertwater)
End Sub
Sub alrtgas()
Dim res As Integer
    pnlGas.BackColor = RED
'    res = soundAlert(Alertgas)
End Sub
Sub monAlert()
'更新:  串行读取报警信号,当数据线上数据为13时认为报警到来
'       且收到13前5个数据为报警有效数据
'最后更新:2000.10.8
'code by: zhangxuan

Dim i As Integer
'警型:
'   8---老人救护    ALERT_LIFE
'   2---防盗        ALERT_ROB
'   1---煤气泄漏    ALERT_GAS
'   0---盗水,盗气   ALERT_WATER
Dim curAlertData() As Integer       '数组存储当前接收到的报警数据
Dim curAlertName As String          '当前报警类型名称
Dim rcAlertRecord As Recordset      '报警记录
Dim rcAlertUserMap As Recordset     '报警用户信息库
Dim ReadData As Integer             '从PORTA_2读取的数据
Dim ReadAlertType As Integer        '读取的报警类型号
Dim ReadAlertUserAddr As Integer    '读取的报警用户板地址
Dim ReadCount As Integer            '已读取读脉冲个数
Dim RFlag As Boolean                '防止重复读取同一脉冲标志
Dim AlertStatus As Integer          '记录报警信号采集返回状态码
                                    '   0---正常,无报警
                                    '   1---超时无反应
                                    '   2---报警信号丢失位
                                    '   3---无法识别报警类型号
                                    '   4---无法找到报警用户信息
                                    '   5---正常收到报警信号


    ReDim curAlertData(curBit)
    ReadCount = 0
    ReadAlertType = &HFF
    ReadAlertUserAddr = 0
    ReadData = 0
    AlertStatus = 0
    RFlag = True
    
    Set rcAlertRecord = dbCbb.OpenRecordset("AlertRecord", dbOpenDynaset)
    Set rcAlertUserMap = dbCbb.OpenRecordset("UserMap", dbOpenSnapshot)
    
    Do
        DoEvents
        
        If QuitAlert Then
            Exit Do
        End If
        '串行报警原理:  首先监测读脉冲,当读脉冲到来时读取数据线上数据,
        '               并且依次写入队列,如果为13则认为前5个数据为报警信号有效数据
        If chkBit(PortB_2, bRead2, 1, 1000) <> 0 Then
            '监测到读脉冲
            If RFlag Then
                '如果RFlag=true表示为新数据到来
                Beep
                RFlag = False
                '从数据口收数据,并只取低四位
                ReadData = chkPort(PortA_2) And &HF
                If ReadData = 13 Then
                    '收到报警有效信号13
                    If ReadCount <> curBit Then
                        '如果从上次收到报警有效信号至今收到的数据与当前数据为设置(curBit)不同,则收到的报警数据无效
                        AlertStatus = 2
                        GoTo ErrMon
                    Else
                        '计数器清零
                        ReadCount = 0
                        '分析报警数据,队列第一个元素值为报警类型
                        '其余为报警用户地址
                        ReadAlertType = curAlertData(1)
                        ReadAlertUserAddr = 0
                        For i = 2 To UBound(curAlertData)
                            ReadAlertUserAddr = ReadAlertUserAddr * 10 + curAlertData(i)
                        Next i
                        '****************************************************************
                        '查找报警类型对应名称
                        curAlertName = getAlertName(ReadAlertType)
                        If Trim(curAlertName) = "" Then
                            AlertStatus = 3
                            GoTo ErrMon
                        End If
                                            
'                        rcAlertUserMap.FindFirst "Address=" + Format(ReadAlertUserAddr)
'                        If rcAlertUserMap.NoMatch Then
'                            AlertStatus = 4
'                            GoTo ErrMon
'                        End If
                        '报警信息写入报警日志
                        With rcAlertRecord
                        .AddNew
                        !AlertType = ReadAlertType
                        !AlertName = curAlertName
                        '!UserID = rcAlertUserMap!UserID
                        '!UserName = rcAlertUserMap!UserName
                        !Date = Date
                        !Time = Time
                        !UserAddress = ReadAlertUserAddr
                        .Update
                        End With
                                            
                        Select Case ReadAlertType
                            Case ALERT_WATER                  'water
                                curAlert(1) = rcAlertUserMap!UserID
                                curAlertDate(1) = Date
                                curAlertTime(1) = Time
                            Case ALERT_GAS                  'gas
                                curAlert(2) = rcAlertUserMap!UserID
                                curAlertDate(2) = Date
                                curAlertTime(2) = Time
                            Case ALERT_ROB                  'rob
                                curAlert(3) = rcAlertUserMap!UserID
                                curAlertDate(3) = Date
                                curAlertTime(3) = Time
                            Case ALERT_LIFE                  'life
                                curAlert(4) = rcAlertUserMap!UserID
                                curAlertDate(4) = Date
                                curAlertTime(4) = Time
                        End Select
                                            
                        EchoAlert (ReadAlertType)           '在显示面板上显示报警
                        AlertStatus = 5
                        GoTo ContinueMon
                        '****************************************************************
                    End If
                Else
                    '计数器清零后每收到一个数据加一,直至等于当前数据位数为止
                    ReadCount = IIf(ReadCount < curBit, ReadCount + 1, ReadCount)
                    '收到的数据依次存入队列curAlertData中
                    '最新收到的数据始终放于数组最后一个元素中
                    For i = 1 To UBound(curAlertData) - 1
                        '队列各元素依次前移
                        curAlertData(i) = curAlertData(i + 1)
                    Next i
                    curAlertData(UBound(curAlertData)) = ReadData
'                    Debug.Print ReadData
                End If
            End If
        Else
            If chkBit(PortB_2, bRead2, 0, 1000) = 0 Then RFlag = True
        End If
        GoTo ContinueMon
ErrMon:
        ReadCount = 0
        ReadAlertType = &HFF
        ReadAlertUserAddr = 0
        ReadData = 0
ContinueMon:
    Loop
End Sub
Sub monAlert_old()
    Dim result As Integer
    Dim fn As Integer
    Dim AlertPos As Long
    Dim i As Integer
    Dim curDate As String * 10
    Dim curTime As String * 8
'警型:
'   8---老人救护    ALERT_LIFE
'   2---防盗        ALERT_ROB
'   1---煤气泄漏    ALERT_GAS
'   0---盗水,盗气   ALERT_WATER

Dim curAlertName As String          '当前报警类型名称
Dim curAlertUserName As String      '当前报警用户姓名
Dim curAlertUserID As Integer       '当前报警用户号
Dim rcAlertRecord As Recordset      '报警记录
Dim rcAlertUserMap As Recordset     '报警用户信息库
Dim ReadData As Integer             '从PORTA_2读取的数据
Dim ReadAlertType As Integer        '读取的报警类型号
Dim ReadAlertUserAddr As Integer    '读取的报警用户板地址
Dim ReadCount As Integer            '已读取读脉冲个数
Dim RFlag As Boolean                '防止重复读取同一脉冲标志
Dim AlertStatus As Integer          '记录报警信号采集返回状态码
                                    '   0---正常,无报警
                                    '   1---超时无反应
                                    '   2---报警信号丢失位
                                    '   3---无法识别报警类型号
                                    '   4---无法找到报警用户信息
                                    '   5---正常收到报警信号

    Do
        DoEvents
        
        If QuitAlert Then
            Exit Do
        End If
        
            If chkBit(PortB_2, bAlert, 1, 1) <> 0 Then        '查看报警信号是否到来
                Alerting = True             '通知系统各部分当前正在接收报警信息
                
                pubTimer1.Enabled = False
                pubTimer1.Interval = 1000
                pubTimerCount1 = 0
                pubTimer1.Enabled = True
                
                RFlag = True
                ReadCount = 0
                ReadAlertType = &HFF
                ReadAlertUserAddr = 0
                ReadData = 0
                AlertStatus = 0         '正常无报警
                Do While True
                    If pubTimerCount1 > 5 Then      '是否超时
                        AlertStatus = 1     '超时
                        Exit Do
                    End If
                    
                    If chkBit(PortB_2, bRead2, 1, 1000) <> 0 Then
                        If RFlag Then
                            Beep
                            ReadData = chkPort(PortA_2) And &HF
                            RFlag = False
                            pubTimerCount1 = 0
                            ReadCount = ReadCount + 1
                                
                            If ReadCount = 1 Then
                                ReadAlertType = ReadData
                            Else
                                ReadAlertUserAddr = ReadAlertUserAddr * 10 + ReadData
                            End If
                        End If
                    Else
                        If chkBit(PortB_2, bRead2, 0, 1000) = 0 Then
                            RFlag = True
                        End If
                    End If