frmgetall.frm

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

                    rcGate.Edit
                    rcGate!StartGateStatus = 2          '如果前向网关打开失败,给该网关做失败标记
                    rcGate!Date = Date
                    rcGate.Update
                    
                    CloseGate (curStartGate)
'status
                    AppendStatusInfo "关闭网段" + Format(curFrameID) + "前向网关" + Format(curStartGate) & "失败", icoBLUE
                    SaveLog "关闭网段" + Format(curFrameID) + "前向网关" + Format(curStartGate) & "失败", 0
                    
                    isForward = False
                    rcGate.MoveLast
                    GoTo BeginGate
                Else                                    '如果当前是后向,则结束采集
                    rcGate.Edit
                    rcGate!EndGateStatus = 2            '如果后向网关打开失败,给该网关做失败标记
                    rcGate!Date = Date
                    rcGate.Update
'status
                    AppendStatusInfo "打开网段" + Format(curFrameID) + "后向网关" + Format(curStartGate) & "失败", icoRED
                    SaveLog "打开网段" + Format(curFrameID) + "后向网关" + Format(curStartGate) & "失败", 1

                    CloseGate (curEndGate)
'status
                    AppendStatusInfo "关闭网段" + Format(curFrameID) + "后向网关" + Format(curStartGate) & "失败", icoBLUE
                    SaveLog "关闭网段" + Format(curFrameID) + "后向网关" + Format(curStartGate) & "失败", 0

                    Exit Do
                End If
            Else
                rcGate.Edit
                rcGate!Status = 1
                If isForward Then
                    rcGate!StartGateStatus = 1
                Else
                    rcGate!EndGateStatus = 1
                End If
                rcGate!Date = Date
                rcGate.Update
            End If
        End If
Gate_GoOn:

'楼内安全器
'安全器状态值:  NULL,0---未知状态
'               1--------正常
'               2--------故障
                rcBuild.FindFirst "FrameID=" + Format(curFrameID)
                Do While Not rcBuild.NoMatch
                    If IsNull(rcBuild!Status) Then
                        GoTo BuildValid
                    End If
                    If rcBuild!Status = 2 Then              '查看安全器是否正常
'status
                        AppendStatusInfo "楼" & rcBuild!BuildID & "安全器故障", icoRED
                        SaveLog "楼" & rcBuild!BuildID & "安全器故障", 1
                        GoTo NextBuild
                    Else
BuildValid:
                        curBuildAddr = rcBuild!Address          '取得安全器地址
                        curBuildID = Trim(rcBuild!BuildID)      '取得该楼号
                        If curBuildID = "" Then                 '如果楼号无效,采集下一个楼
'status
                            AppendStatusInfo "无效的楼号,采集下一楼", icoBLUE
                            SaveLog "无效的楼号,采集下一楼", 0
                            GoTo NextBuild
                        Else
                            If curBuildAddr = 0 Then
                                rcBuild.Edit
                                rcBuild!Status = 0
                                rcBuild.Update
                                GoTo Build_GoOn
                            End If
                            
                            strBuild = " " + curBuildID + "楼 "
'status
                            AppendStatusInfo "打开楼" + Format(curBuildID) + " 安全器" + Format(curBuildAddr), icoBLUE
                            SaveLog "打开楼" + Format(curBuildID) + " 安全器" + Format(curBuildAddr), 0
                            
                            BuildStatus = openBuild(curBuildAddr)    '打开当前楼内安全器
                            If Not BuildStatus Then
                                rcBuild.Edit
                                rcBuild!Status = 2
                                rcBuild!Date = Date
                                rcBuild.Update
'status
                                AppendStatusInfo "打开楼" + curBuildID + "安全器" + curBuildAddr + "失败,正在关闭", icoRED
                                SaveLog "打开楼" + curBuildID + "安全器" + curBuildAddr + "失败,正在关闭", 1
                                
                                CloseBuild (curBuildAddr)
                                rcBuild.Edit
                                rcBuild!Status = 1      '安全器故障
                                rcBuild!Date = Date
                                rcBuild.Update
                                GoTo NextBuild
                            Else
                                rcBuild.Edit
                                rcBuild!Status = 1
                                rcBuild!Date = Date
                                rcBuild.Update
                            End If
                        End If
                    End If
Build_GoOn:

'用户
'状态值:    0---正常
'           1---用户板超时无反应
'           2---用户板信号错误2(丢失换表脉冲)       '丢失换表脉冲
'           3---用户板信号错误3(丢失读脉冲) "      '丢失读脉冲
'           4---用户板信号错误4"
'           >9--收到用户板无效数据
'           Else---用户板信号错误 "       '其他未知原因
                            
                            ReadCount = 0
                            rcUserMap.FindFirst "trim(BuildID)=""" + curBuildID + """"
                            Do While Not rcUserMap.NoMatch
                                curUserID = rcUserMap!UserID
'                                If IsNull(rcUserMap!Address) Then
''status
'                                    AppendStatusInfo "用户:" + Format(curUserID) & "地址无效", icoRED
'                                    SaveLog "用户:" + Format(curUserID) & "地址无效", 1
'                                    GoTo NextUser
'                                Else
'                                    curUserAddr = rcUserMap!Address
'                                End If
                                If IsNull(rcUserMap!Devs) Then
                                    curUserDevs = 0
                                Else
                                    curUserDevs = rcUserMap!Devs
                                End If
                                If curUserID <> 0 Then
                                    strUser = " 用户" + Format(curUserID) + " "
                                      If CancelCollect Then
                                          Done
                                          frmMain.videoMain.Visible = False
                                          Exit Sub
                                      End If
    'status
                                      StatusStr = "采集：网段" + Format(FrameID) + "  楼" + curBuildID + "  用户" + Format(curUserID) + "  地址" + Format(curUserAddr)
                                      AppendStatusInfo StatusStr, IIf(strHead = "采集:", icoBLUE, icoYELLOW)
                                      SaveLog StatusStr, IIf(strHead = "采集:", 0, 2)
                                      
    '------------------------------------------------------------------------------------------------------------------------------------
                                      ReDim DData(curUserDevs)
                                      rcUserDev.FindFirst "UserID=" & curUserID
                                      Do While Not rcUserDev.NoMatch
                                          curCardAddr = rcUserDev!CardTermID
                                          curDevAddr = rcUserDev!CardUserID
                                          curDevID = rcUserDev!devID
                                          curDevTypeID = rcUserDev!DevType
                                          curCollectType = 0
                                          
                                          rcDevsMap.FindFirst "TypeID=" & curDevTypeID
                                          If Not rcDevsMap.EOF Then curCollectType = rcDevsMap!collectType
                                          
                                          For retrytimes = 1 To gCapRetryTimes         '采集失败时,自动重试一次
                                              If retrytimes = gCapRetryTimes Then
                                                  closeDev curCardAddr
                                                  Delay 1, 5
                                                  closeCard
                                                  Delay 1, 20
                                                  If CancelCollect Then
                                                      Done
                                                      frmMain.videoMain.Visible = False
                                                      Exit Sub
                                                  End If
                                              End If
                                              If curCollectType = 0 Then
                                                  '采集脉冲表
                                                  collectStatus = CollectUserData_pul(curUserID, curDevID, curCardAddr, curDevAddr)
                                              ElseIf curCollectType = 1 Then
                                                  '采集图象表
                                                  collectStatus = CollectUserData_pic(curUserID, curDevID, curCardAddr, curDevAddr, gCurJPGdir)
                                              End If
'            Debug.Print "DData(" & curDevID & ")=" & DData(curDevID)
                                              If collectStatus = 0 Then
                                                  Exit For
                                              Else
                                                  collectStatus = 0
                                              End If
                                          Next retrytimes
                                          
                                          rcUserDev.FindNext "UserID=" & curUserID
                                      Loop
                                      closeDev curCardAddr
                                      Delay 1, 5
                                      closeCard
                                      
                                      If CancelCollect Then
                                          Done
                                          frmMain.videoMain.Visible = False
                                          Exit Sub
                                      End If
                                      If collectStatus = 0 Then
                                          For i = 1 To curUserDevs
                                              rcUserData.AddNew
                                              rcUserData!UserID = curUserID
                                              rcUserData!devID = i
                                              rcUserData!Value = DData(i)
                                              rcUserData!Status = 0
                                              rcUserData!Date = Date
                                              rcUserData.Update
              
                                              rcUserData2.AddNew
                                              rcUserData2!UserID = curUserID
                                              rcUserData2!devID = i
                                              rcUserData2!Value = DData(i)
                                              rcUserData2!Status = 0
                                              rcUserData2!Date = Date
                                              rcUserData2.Update
                                              
                                              UpdateUserFee curUserID, i, DData(i)
                                          Next i
                                      End If
    '------------------------------------------------------------------------------------------------------------------------------------
                                      
                                      rcUserMap.Edit
                                      rcUserMap!Status = collectStatus        '保存采集状态结果
                                      rcUserMap!Date = Date
                                      rcUserMap.Update
    'status
                                      StatusStr = getUserStatusStr(collectStatus)
                                      AppendStatusInfo StatusStr, IIf(collectStatus = 0, icoBLUE, icoRED)
                                      SaveLog StatusStr, IIf(collectStatus = 0, 0, 1)
                                End If
                                'Delay 1, 60
NextUser:
                                rcUserMap.FindNext "trim(BuildID)=""" + curBuildID + """"
                                DoEvents
                            Loop
'status
                    Delay 1, 2
                    StatusStr = "关闭楼" + Format(curBuildID) + " 安全器" + Format(curBuildAddr)
                    AppendStatusInfo StatusStr, icoBLUE
                    SaveLog StatusStr, 0
                    
                    CloseBuild (curBuildAddr)
NextBuild:
                    rcBuild.FindNext "FrameID=" + Format(curFrameID)
                    DoEvents
                Loop
            'End If
NextGate:
        If isForward Then
            rcGate.MoveNext
        Else
            rcGate.MovePrevious
        End If
        DoEvents
    Loop
    MsgBox "全程采集完毕", vbOKOnly + vbInformation, "采集数据"
End Sub

Private Sub cmdCancel_Click()
    CancelCollect = True
    DelayCancel = True
    Unload frmGetAll
    
End Sub

Sub cmdOK_Click()
    gblnCollecting = True
    If BrowInfo = True Then
        frmMainInfo.lstStatus.ListItems.Clear
    End If
    'If chkNet.Value Then
        'checkNet
    'End If
'status
    AppendStatusInfo "开始全程采集...", icoBLUE
    SaveLog "开始全程采集...", 0
    
    Me.MousePointer = 11
    CollectData
    FreshUserStatus
    If Not CancelCollect Then
        Me.MousePointer = 0
   End If
'status
    gblnCollecting = False
    AppendStatusInfo "全程采集完毕", icoBLUE
    SaveLog "全程采集完毕", 0
    
End Sub

Private Sub cmdsetdate_Click()
    Select Case SetStatus
        Case True       '开始设置日期
            cmdSetDate.Caption = "确定"
            txtDate.Visible = True
            lblDate.Visible = False
        Case False      '保存设置日期
            cmdSetDate.Caption = "设置"
            If Not IsDate(txtDate.Text) Then
                MsgBox "无效的日期表达式" + Chr(10) + "格式:""年/月/日""", , "设置日期"
                Exit Sub
            End If
            Date = CDate(txtDate.Text)
            txtDate.Text = Format(Date, "yyyy/m/d")
            lblDate = Format(Date, "yyyy/m/d")
            lblDate.Visible = True
            txtDate.Visible = False
    End Select
    SetStatus = Not SetStatus
End Sub

Private Sub Form_Load()
    If UBound(curForm) > 0 Then
        curForm(UBound(curForm)).Enabled = False
    End If
    ReDim Preserve curForm(UBound(curForm) + 1)
    Set curForm(UBound(curForm)) = Me

    ExitFlag = False
    
    lblDate.Visible = True
    lblDate = Format(Date, "yyyy/m/d")
    lblDate.Top = txtDate.Top
    lblDate.Left = txtDate.Left
    lblDate.Width = txtDate.Width
    lblDate.Height = txtDate.Height
    txtDate.Visible = False
    txtDate.Text = Format(Date, "yyyy/m/d")
    cmdSetDate.Caption = "设置"
    SetStatus = True
    
    DoEvents
End Sub



Private Sub Form_Unload(Cancel As Integer)
    ReDim Preserve curForm(UBound(curForm) - 1)
    If UBound(curForm) > 0 Then
        curForm(UBound(curForm)).Enabled = True
    End If

End Sub