frmgetall.frm

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

VERSION 5.00
Begin VB.Form frmGetAll 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "全程采集"
   ClientHeight    =   2295
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   2295
   ScaleWidth      =   4680
   Begin VB.TextBox txtDate 
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00000000&
      Height          =   285
      Left            =   1800
      TabIndex        =   4
      Top             =   360
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "采集"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   960
      TabIndex        =   3
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "返回"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2520
      TabIndex        =   2
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CheckBox chkNet 
      Caption         =   "采集前进行网络巡检"
      Height          =   255
      Left            =   1320
      TabIndex        =   1
      Top             =   1200
      Value           =   1  'Checked
      Width           =   2535
   End
   Begin VB.CommandButton cmdSetDate 
      Caption         =   "设置"
      Height          =   285
      Left            =   3330
      TabIndex        =   0
      Top             =   360
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "当前日期为:"
      Height          =   255
      Left            =   600
      TabIndex        =   7
      Top             =   360
      Width           =   1215
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Caption         =   "确定日期正确开始采集,按""设置""键可修改日期"
      Height          =   255
      Left            =   240
      TabIndex        =   6
      Top             =   840
      Width           =   4215
   End
   Begin VB.Label lblDate 
      BorderStyle     =   1  'Fixed Single
      Height          =   300
      Left            =   1800
      TabIndex        =   5
      Top             =   240
      Width           =   1215
   End
End
Attribute VB_Name = "frmGetAll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/09
'描    述：CBB三表户外计量系统 Ver 5.2
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Dim SetStatus As Boolean
Dim rcUserFee As Recordset
Dim rcDevsMap As Recordset
Dim curBuildID As String            '当前楼号
Dim curBuildAddr As Integer         '当前安全器地址
Sub InitNet()
'初始化所有网关及安全器状态
Dim rcBuild As DAO.Recordset
Dim rcGate As DAO.Recordset
Dim temBuildID As Integer
Dim temBuildAddr As Integer
Dim temSGate As Integer
Dim temEGate As Integer
Dim temGateID As Integer

'关闭网关
    On Error GoTo err_OpenGate
    Set rcGate = dbCbb.OpenRecordset("GateMap", dbOpenDynaset)
    On Error GoTo 0
    Do Until rcGate.EOF
        If Not IsNull(rcGate!StartGate) _
                And Not IsNull(rcGate!endGate) _
                And Not IsNull(rcGate!FrameID) Then
            temGateID = rcGate!FrameID
            temSGate = rcGate!StartGate
            temEGate = rcGate!endGate
            
            If temSGate <> 0 Then
'status
                AppendStatusInfo "关闭网段[" + Trim(temGateID) + "]前向网关[" + Format(temSGate) & "]", icoBLUE
                SaveLog "关闭网段[" + Trim(temGateID) + "]前向网关[" + Format(temSGate) & "]", 0
                
                CloseGate (temSGate)
            End If
            If temEGate <> 0 Then
'status
                AppendStatusInfo "关闭网段[" + Trim(temGateID) + "]后向网关[" + Format(temEGate) & "]", icoBLUE
                SaveLog "关闭网段[" + Trim(temGateID) + "]后向网关[" + Format(temEGate) & "]", 0
                
                CloseGate (temEGate)
            End If
            
        End If
        
        rcGate.MoveNext
    Loop
   
lbl_CloseBuild:
'关闭安全器
    On Error GoTo err_OpenBuild
    Set rcBuild = dbCbb.OpenRecordset("BuildMap", dbOpenDynaset)
    On Error GoTo 0
    Do Until rcBuild.EOF
        If Not IsNull(rcBuild!Address) And Not IsNull(rcBuild!BuildID) Then
            temBuildID = rcBuild!BuildID
            temBuildAddr = rcBuild!Address
            
'status
            AppendStatusInfo "关闭楼" + Trim(temBuildID) + " 安全器" + Format(temBuildAddr), icoBLUE
            SaveLog "关闭楼" + Trim(temBuildID) + " 安全器" + Format(temBuildAddr), 0
            
            CloseBuild (temBuildAddr)
        End If
        
        rcBuild.MoveNext
    Loop
    Exit Sub
    
err_OpenBuild:
'status
    AppendStatusInfo "无法打开系统表得到网络安全器信息", icoRED
    SaveLog "无法打开系统表得到网络安全器信息", 0
    Resume lbl_CloseBuild
err_OpenGate:
'status
    AppendStatusInfo "无法打开系统表得到网段信息", icoRED
    SaveLog "无法打开系统表得到网段信息", 0
    Exit Sub
End Sub
Sub Done()
    'status
        StatusStr = "关闭楼" + Format(curBuildID) + " 安全器" + Format(curBuildAddr)
        AppendStatusInfo StatusStr, icoBLUE
        SaveLog StatusStr, 0
        
        CloseBuild (curBuildAddr)
End Sub

Sub CollectData()
Dim isForward As Boolean            '前向，后向
Dim retrytimes As Integer           '自动重试次数

Dim strHead As String
Dim strBuild As String
Dim strUser As String
Dim strStatus As String

Dim rcGate As Recordset
Dim rcBuild As Recordset
Dim rcUserMap As Recordset
Dim rcUserData As Recordset
Dim rcUserData2 As Recordset
Dim rcUserDev As Recordset

Dim curStartGate As Integer         '当前网段前向网关号
Dim curEndGate As Integer           '当前网段后向网关号
Dim curFrameID As Integer           '当前网段号
Dim curUserID As Integer            '当前用户号
Dim curUserAddr As Integer          '当前用户地址
Dim curUserDevs As Integer          '当前用户设备数
Dim curCardAddr As Integer          '当前用户采集板地址
Dim curDevAddr As Integer           '当前表在采集板上的板内地址
Dim curDevID As Integer             '当前表的在用户表中的序号

Dim GateStatus As Boolean
Dim BuildStatus As Boolean
Dim collectStatus As Integer        '当前用户采集状态   0--正常结束
                                    '                   1--超时退出
                                    '                   2--丢失换表脉冲
                                    '                   3--丢失读脉冲
    '====================================================================
    '在全程采集之前先初始化网络状态，关闭所有网关及安全器
    InitNet
    '====================================================================
    
    CancelCollect = False
    frmMain.videoMain.Visible = True
    
    Set rcUserFee = dbCbb.OpenRecordset("userdev", dbOpenDynaset)
    Set rcDevsMap = dbCbb.OpenRecordset("devsmap", dbOpenSnapshot)
    
    SQL = "select * from GateMap order by FrameID ASC "
    Set rcGate = dbCbb.OpenRecordset(SQL, dbOpenDynaset)
    Set rcBuild = dbCbb.OpenRecordset("BuildMap", dbOpenDynaset)
    SQL = "select * from UserMap order by UserID ASC "
    Set rcUserMap = dbCbb.OpenRecordset(SQL, dbOpenDynaset)
    Set rcUserData = dbCbb.OpenRecordset("UserData", dbOpenDynaset)
    Set rcUserData2 = dbCbb.OpenRecordset("UserData2", dbOpenDynaset)
    Set rcUserDev = dbCbb.OpenRecordset("UserDev", dbOpenSnapshot)
        
    rcUserData.FindFirst "Date=#" + Format(Date) + "#"
    If Not rcUserData.NoMatch Then
        If Not Auto_Manual Then
            If MsgBox("该日数据已经采集" + Chr(10) + "确定覆盖原数据吗?", 48 + 1, "数据采集") = 2 Then
                frmMain.videoMain.Visible = False
                Exit Sub
            End If
        End If
'status
        AppendStatusInfo "数据库中发现相同日期" & Date & "数据,决定覆盖", icoBLUE
        SaveLog "数据库中发现相同日期" & Date & "数据,决定覆盖", 0
        
        SQL = "delete * from userdata "
        SQL = SQL + "where Date=#" + Format(Date) + "#"
        dbCbb.Execute SQL
        
        SQL = "delete * from userdata2 "
        SQL = SQL + "where Date=#" + Format(Date) + "#"
        dbCbb.Execute SQL
        
        Set rcUserData = dbCbb.OpenRecordset("UserData", dbOpenDynaset)
        Set rcUserData2 = dbCbb.OpenRecordset("UserData2", dbOpenDynaset)
    End If
begin_start:
'===========================================================================
'开始采集
    '网关
    If rcGate.EOF Then
        frmMain.videoMain.Visible = False
        Exit Sub
    End If
    rcGate.MoveFirst
    isForward = True
    Do While Not rcGate.EOF
BeginGate:
'网关状态值:NULL,0---未知状态
'           1--------正常
'           2--------故障
        If IsNull(rcGate!Status) Then
            GoTo GateValid
        End If
        If rcGate!Status = 2 Then        '判断当前网关是否正常
'status
            AppendStatusInfo "网段" & rcGate!FrameID & "故障", icoBLUE
            SaveLog "网段" & rcGate!FrameID & "故障", 0
            GoTo NextGate
        Else
GateValid:
            curFrameID = rcGate!FrameID                 '取得网段号
            curStartGate = rcGate!StartGate             '取得前向网关地址
            curEndGate = rcGate!endGate                 '取得后向网关地址
            If isForward Then                           '判断是否前向打开网关
                If curStartGate = 0 Then
                    GoTo Gate_GoOn
                End If
'status
                AppendStatusInfo "打开网段" + Format(curFrameID) + "前向网关" + Format(curStartGate), icoBLUE
                SaveLog "打开网段" + Format(curFrameID) + "前向网关" + Format(curStartGate), 0
                
                GateStatus = openGate(curStartGate)     '打开前向网关
            Else
                If curEndGate = 0 Then
                    rcGate.Edit
                    rcGate!Status = 0
                    rcGate!StartGateStatus = 0
                    rcGate!EndGateStatus = 0
                    rcGate.Update
                    GoTo Gate_GoOn
                End If
'status
                AppendStatusInfo "打开网段" + Format(curFrameID) + "后向网关" + Format(curEndGate), icoBLUE
                SaveLog "打开网段" + Format(curFrameID) + "后向网关" + Format(curEndGate), 0
                
                GateStatus = openGate(curEndGate)       '打开后向网关
            End If
            If Not GateStatus Then                      '如果网关打开失败,关闭当前网关
                rcGate.Edit
                rcGate!Status = 2                       'if fail to open Gate then set STATUS 2
                rcGate!Date = Date
                rcGate.Update
                If isForward Then                       '如果当前是前向,则换为后向采集
'status
                    AppendStatusInfo "打开网段" + Format(curFrameID) + "前向网关" + Format(curStartGate) & "失败", icoRED
                    SaveLog "打开网段" + Format(curFrameID) + "前向网关" + Format(curStartGate) & "失败", 1