frmgetsome.frm

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

    
    If Not rcGate.EOF Then
        rcGate.MoveLast
        FrameSum = rcGate.RecordCount
        rcGate.MoveFirst
    Else
        frmMain.videoMain.Visible = False
        Exit Sub
    End If
    
    Set rcBuild = dbCbb.OpenRecordset("BuildMap", dbOpenDynaset)
    
    SQL = "select * from temUser "  ' order by UserID ASC "
    Set rcUser = dbCbb.OpenRecordset(SQL, dbOpenDynaset)
    If rcUser.EOF Then
        frmMain.videoMain.Visible = False
        Exit Sub
    End If
'status
    AppendStatusInfo "开始采集指定用户数据...", icoBLUE
    SaveLog "开始采集指定用户数据...", 0
    Me.MousePointer = 11
    Do While Not rcUser.EOF                 '从待采用户队列中依次取出用户
        curUserID = rcUser!UserID
        'Debug.Print "UserID=" & curUserID
'        If IsNull(rcUser!Address) Then
''status
'            AppendStatusInfo "用户:" + Format(curUserID) & "地址无效", icoRED
'            SaveLog "用户:" + Format(curUserID) & "用户地址无效", 1
'            GoTo NextUser
'        Else
'            curUserAddr = rcUser!Address
'        End If
        rcUserMap.FindFirst "UserID=" + Format(curUserID)
        If Not rcUserMap.NoMatch Then
            If IsNull(rcUserMap!Devs) Then
                curUserDevs = 0
            Else
                curUserDevs = rcUserMap!Devs
            End If
        Else
            frmMain.videoMain.Visible = False
            Exit Sub
        End If
        If CancelCollect Then
'status
            AppendStatusInfo "强制中止采集", icoBLUE
            SaveLog "强制中止采集", 0
            Done
            frmMain.videoMain.Visible = False
            Exit Sub
        End If
'label
'status
        AppendStatusInfo "开始采集用户:" + Format(curUserID), icoBLUE
        SaveLog "开始采集用户:" + Format(curUserID), 0
        
        isForward = True
        
        curBuildID = rcUser!BuildID
        rcBuild.FindFirst "BuildID=""" + Trim(curBuildID) + """"    '查询该用户所属网段
        If Not rcBuild.NoMatch Then
            curBuildAddr = rcBuild!Address
            rcGate.FindFirst "FrameID=" + Format(rcBuild!FrameID)
            If Not rcGate.NoMatch Then
                curFrameID = rcGate!FrameID
                
                For i = 1 To curFrameID         '前向依次打开当前网段前的所有网关
                    rcGate.FindFirst "FrameID=" + Format(i)
                    If Not rcGate.NoMatch Then
                        curStartGate = rcGate!StartGate
                        
                        If curStartGate = 0 Then    '如果网关地址为0,表示该网关已被取消
                            rcGate.Edit
                            rcGate!Status = 0
                            rcGate!StartGateStatus = 0
                            rcGate!EndGateStatus = 0
                            rcGate.Update
                            GoTo Next_StartGate:
                        End If
'status
                        AppendStatusInfo "打开网段" + Format(i) + " 前向网关" + Format(curStartGate), icoBLUE
                        SaveLog "打开网段" + Format(i) + " 前向网关" + Format(curStartGate), 0
                        If Not openGate(curStartGate) Then          '有任意一个网关不能打开,则关闭已打开的网关,再后向打开当前网段之后的所有网段
                            rcGate.Edit
                            rcGate!StartGateStatus = 2
                            rcGate!Status = 2
                            rcGate!Date = Date
                            rcGate.Update
'status
                            AppendStatusInfo "打开网段" + Format(i) + " 前向网关" + Format(curStartGate) + "失败", icoRED
                            SaveLog "打开网段" + Format(i) + " 前向网关" + Format(curStartGate) + "失败", 1
                            isForward = False
                            Exit For
                        Else
                            rcGate.Edit
                            rcGate!Status = 1
                            rcGate!StartGateStatus = 1
                            rcGate!Date = Date
                            rcGate.Update
                        End If
                    End If
Next_StartGate:
                Next i
                If Not isForward Then               '后向打开网关
                    For i = FrameSum To curFrameID Step -1
                        rcGate.FindFirst "FrameID=" + Format(i)
                        If Not rcGate.NoMatch Then
                            curEndGate = rcGate!endGate
                            
                            If curEndGate = 0 Then    '如果网关地址为0,表示该网关可以被跳过
                                GoTo Next_EndGate:
                            End If
'status
                            AppendStatusInfo "反向打开网段" + Format(i) + " 后向网关" + Format(curEndGate), icoBLUE
                            SaveLog "反向打开网段" + Format(i) + " 后向网关" + Format(curEndGate), 0
                            If Not openGate(curEndGate) Then    '如果依然不成功,本户采集失败,采集下一户
                                rcGate.Edit
                                rcGate!Status = 2
                                rcGate!EndGateStatus = 2
                                rcGate!Date = Date
                                rcGate.Update
'status
                                AppendStatusInfo "反向打开网段" + Format(i) + " 后向网关" + Format(curEndGate) + "失败", icoRED
                                SaveLog "反向打开网段" + Format(i) + " 后向网关" + Format(curEndGate) + "失败", 1
                                GoTo NextUser
                            Else
                                rcGate.Edit
                                rcGate!Status = 1
                                rcGate!EndGateStatus = 1
                                rcGate!Date = Date
                                rcGate.Update
                            End If
                        End If
Next_EndGate:
                    Next i
                End If
            Else
                GoTo NextUser
            End If
            
'status
            AppendStatusInfo "打开楼" + Trim(curBuildID) + " 安全器" + Format(curBuildAddr), icoBLUE
            SaveLog "打开楼" + Trim(curBuildID) + " 安全器" + Format(curBuildAddr), 1
            
            If curBuildAddr = 0 Then
                rcBuild.Edit
                rcBuild!Status = 0
                rcBuild.Update
                GoTo Next_Build
            End If
            If Not openBuild(curBuildAddr) Then       '打开当前用户所在楼安全器
                rcBuild.Edit
                rcBuild!Status = 2
                rcBuild!Date = Date
                rcBuild.Update
                
'status
                AppendStatusInfo "打开楼" + Trim(curBuildID) + " 安全器" + Format(curBuildAddr) + "失败", icoRED
                SaveLog "打开楼" + Trim(curBuildID) + " 安全器" + Format(curBuildAddr) + "失败", 1
                CloseBuild (curBuildAddr)
'status
                AppendStatusInfo "关闭楼" + Trim(curBuildID) + " 安全器" + Format(curBuildAddr), icoRED
                SaveLog "关闭楼" + Trim(curBuildID) + " 安全器" + Format(curBuildAddr), 1
                GoTo NextUser
            Else
                rcBuild.Edit
                rcBuild!Status = 1
                rcBuild!Date = Date
                rcBuild.Update
            End If
        Else
            GoTo NextUser
        End If

Next_Build:
        If CancelCollect Then
            Done
            frmMain.videoMain.Visible = False
            Exit Sub
        End If
'status
        AppendStatusInfo "采集：网段:" + Format(curFrameID) + "  楼:" + Trim(curBuildID) + "  用户:" + Format(curUserID), _
                 IIf(strHead = "重试:", icoBLUE, icoYELLOW)
        SaveLog strHead + "采集：网段:" + Format(curFrameID) + "  楼:" + Trim(curBuildID) + "  用户:" + Format(curUserID), _
                IIf(strHead = "重试:", 2, 0)
'------------------------------------------------------------------------------------------------------
        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.NoMatch 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 captest = 1 Then
                    openDev curCardAddr, curDevAddr
                    frmMain.videoMain.Visible = False
                    Exit Sub
                ElseIf captest = 2 Then
                    closeDev curCardAddr
                    frmMain.videoMain.Visible = False
                    Exit Sub
                End If
                If curCollectType = 0 Then
                    '采集脉冲表
                    collectStatus = CollectUserData_pul(curUserID, curDevID, curCardAddr, curDevAddr)
                Else
                    '采集图象表
                    'collectStatus = CollectUserData_pic(curUserID, curUserAddr, curUserDevs, gCurJPGdir)
                    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
                rcTemUserData.AddNew
                rcTemUserData!UserID = curUserID
                rcTemUserData!devID = i
                rcTemUserData!Value = DData(i)
                rcTemUserData!Status = 0
                rcTemUserData!Date = Date
                rcTemUserData.Update
            Next i
        End If
'------------------------------------------------------------------------------------------------------
        rcUserMap.FindFirst "UserID=" + Format(curUserID)
        rcUserMap.Edit
        rcUserMap!Status = collectStatus        '保存采集状态结果
        rcUserMap!Date = Date
        rcUserMap.Update
        
'status
        AppendStatusInfo getUserStatusStr(collectStatus), IIf(collectStatus = 0, icoBLUE, icoRED)
        SaveLog getUserStatusStr(collectStatus), IIf(collectStatus = 0, 0, 1)
'status
        'Delay 1, 10
        AppendStatusInfo "关闭楼" + Trim(curBuildID) + " 安全器" + Format(curBuildAddr), icoBLUE
        SaveLog "关闭楼" + Trim(curBuildID) + " 安全器" + Format(curBuildAddr), 0
        CloseBuild (curBuildAddr)
NextUser:
        rcUser.MoveNext
    Loop
    
'status
    AppendStatusInfo "全部采集完毕,关闭所有网关", icoBLUE
    SaveLog "全部采集完毕,关闭所有网关", 0
    CloseAllGate    '全部采集完毕,关闭所有网关
    Me.MousePointer = 0
    frmMain.videoMain.Visible = False
End Sub


Sub InsertUser(id As Long)
    rcTemUserMap.AbsolutePosition = id
    datUser.Recordset.FindFirst "UserID=" + Format(rcTemUserMap!UserID) '+ " and Address=" + Format(rcTemUserMap!Address)
    If Not datUser.Recordset.NoMatch Then
        Exit Sub
    End If
    If rcTemUserMap.RecordCount > id Then
        datUser.Recordset.AddNew
        datUser.Recordset!BuildID = rcTemUserMap!BuildID
        datUser.Recordset!Door = rcTemUserMap!Door
        datUser.Recordset!userName = rcTemUserMap!userName
        datUser.Recordset!Address = rcTemUserMap!Address
        datUser.Recordset!UserID = rcTemUserMap!UserID
        datUser.Recordset.Update
    End If
    datUser.Refresh
    grdUser.Refresh
End Sub


Sub InsertUser_old(UserStr As String)
Dim insBuildID As String
Dim insUserID As Integer
Dim insUserName As String
Dim insAddress As Integer
Dim temStr As String
Dim pos1 As Integer         '记录第一个"/"在UserStr中的位置