⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmneterror.frm

📁 一个功能比较完善的远程抄表软件
💻 FRM
字号:
VERSION 5.00
Begin VB.Form frmNetError 
   Caption         =   "网络状态监视"
   ClientHeight    =   5295
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8670
   Icon            =   "frmNetError.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   5295
   ScaleWidth      =   8670
   Begin VB.CommandButton cmdOK 
      Cancel          =   -1  'True
      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            =   7200
      TabIndex        =   1
      Top             =   4800
      Width           =   1215
   End
   Begin VB.ListBox lstFrame 
      Columns         =   2
      Height          =   600
      Left            =   120
      TabIndex        =   5
      Top             =   360
      Width           =   8415
   End
   Begin VB.ListBox lstBuild 
      Columns         =   2
      Height          =   960
      Left            =   120
      TabIndex        =   4
      Top             =   1320
      Width           =   8415
   End
   Begin VB.ListBox lstUser 
      Columns         =   2
      Height          =   1860
      Left            =   120
      MultiSelect     =   2  'Extended
      TabIndex        =   3
      Top             =   2640
      Width           =   8415
   End
   Begin VB.CommandButton cmdGet 
      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            =   4560
      TabIndex        =   2
      Top             =   4800
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.CommandButton cmdPrint 
      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            =   5880
      TabIndex        =   0
      Top             =   4800
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.Label lblFrame 
      BackStyle       =   0  'Transparent
      Caption         =   "网段:"
      Height          =   255
      Left            =   240
      TabIndex        =   10
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label lblBuild 
      BackStyle       =   0  'Transparent
      Caption         =   "楼总线:"
      Height          =   255
      Left            =   240
      TabIndex        =   9
      Top             =   1080
      Width           =   1215
   End
   Begin VB.Label lblUser 
      BackStyle       =   0  'Transparent
      Caption         =   "用户:"
      Height          =   255
      Left            =   240
      TabIndex        =   8
      Top             =   2400
      Width           =   1215
   End
   Begin VB.Label lblBGate 
      BackStyle       =   0  'Transparent
      Height          =   255
      Left            =   1440
      TabIndex        =   7
      Top             =   1080
      Width           =   1575
   End
   Begin VB.Label lblUBuild 
      BackStyle       =   0  'Transparent
      Height          =   255
      Left            =   1440
      TabIndex        =   6
      Top             =   2400
      Width           =   1695
   End
End
Attribute VB_Name = "frmNetError"
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  :Mndsoft@163.com
'e-mail  :Mndsoft@126.com
'OICQ    :88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Private Sub cmdOK_Click()
    Unload frmNetError
End Sub

Private Sub cmdPrint_Click()
Dim curFrameStr As String
Dim curFrame As Integer
Dim temStr As String
Dim rcBuild As Recordset
Dim rcUser As Recordset

    SQL = "select * from BuildMap order by FrameID ASC "
    Set rcBuild = dbCbb.OpenRecordset(SQL)
    SQL = "select * from UserMap order by BuildID ASC "
    Set rcUser = dbCbb.OpenRecordset(SQL)
    
    Printer.Print
    Printer.Print "网络故障检修单"
    Printer.Print "================"
    Printer.Print
    Printer.Print "1. 网段:"
    For i = 1 To lstFrame.ListCount
        Printer.Print "        " + lstFrame.List(i - 1)
    Next i
    Printer.Print
    Printer.Print "2. 公寓楼:"
    rcBuild.MoveFirst
    Do While Not rcBuild.EOF
        temStr = Format(rcBuild!FrameID) + "--楼:" + Trim(rcBuild!BuildID)
        If IsNull(rcBuild!Status) Then
            temStr = temStr + "(待测)"
        Else
            Select Case rcBuild!Status
                Case 0
                    temStr = temStr + "(待测)"
                Case 1
                    temStr = temStr + "(正常)"
                Case 2
                    temStr = temStr + "(故障)/安全器" + Format(rcBuild!Address)
                Case 3
                    temStr = temStr + "(故障)/终端器" + Format(rcBuild!Address)
            End Select
        End If
        temStr = temStr + "(" + getStatusStr(rcBuild!Status) + ")"
        temStr = temStr + "/"
    Loop
    For i = 1 To lstFrame.ListCount
        curFrameStr = Trim(lstFrame.List(i - 1))
        If curFrameStr <> "" Then
            curFrameID = Val(Left(curFrameStr, InStr(1, curFrameStr, "(") - 1))
            If curFrameID <> 0 Then
                rcBuild.FindFirst "FrameID=" + Format(curFrameID)
                Do While Not rcBuild.NoMatch
                    temStr = Format(curFrameID) + "--" + "楼:" + rcBuild!BuildID
                    rcBuild.FindNext "FrameID=" + Format(curFrameID)
                Loop
            End If
        End If
    Next i
    
    
    curFrameStr = Trim(lstFrame.List(lstFrame.ListIndex))
    If curFrameStr <> "" Then
        curFrameID = Val(Left(curFrameStr, InStr(1, curFrameStr, "(") - 1))
        lblBGate = "网段:" + Format(curFrameID)
        If curFrameID <> 0 Then
            rcBuild.FindFirst "FrameID=" + Format(curFrameID)
            Do While Not rcBuild.NoMatch
                temStr = Trim(rcBuild!BuildID)
                If Not IsNull(rcBuild!Status) Then
                    Select Case rcBuild!Status
                        Case 0
                            temStr = temStr + "(待测)"
                        Case 1
                            temStr = temStr + "(正常)"
                        Case 2
                            temStr = temStr + "(故障)/安全器" + Format(rcBuild!Address) + "(故障)"
                        Case 3
                            temStr = temStr + "(故障)/终端器" + Format(rcBuild!Ender) + "(故障)"
                        Case Is > 3
                            temStr = temStr + "(故障)"
                    End Select
                Else
                    temStr = temStr + "(待测)"
                End If
                If Trim(Format(rcBuild!Date, "yyyy.m.d")) <> "" Then
                    temStr = temStr + "/" + Format(rcBuild!Date, "yyyy.m.d")
                End If
                lstBuild.AddItem temStr
                rcBuild.FindNext "FrameID=" + Format(curFrameID)
            Loop
        End If
    End If
    
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

    
Dim rcFrame As Recordset
Dim temStr As String

    SQL = "select * from GateMap order by FrameID ASC "
    Set rcFrame = dbCbb.OpenRecordset(SQL)
    If rcFrame.RecordCount > 0 Then
        rcFrame.MoveFirst
        Do While Not rcFrame.EOF
            temStr = Format(rcFrame!FrameID)
            If Not IsNull(rcFrame!Status) Then
                Select Case rcFrame!Status
                    Case 0
                        temStr = temStr + "(待测)"
                    Case 1
                        temStr = temStr + "(正常)"
                    Case Is > 1
                        temStr = temStr + "(故障)"
                End Select
            Else
                temStr = temStr + "(待测)"
            End If
            temStr = temStr + "/前向网关:" + Format(rcFrame!StartGate)
            If Not IsNull(rcFrame!StartGateStatus) Then
                Select Case rcFrame!StartGateStatus
                    Case 0
                        temStr = temStr + "(待测)"
                    Case 1
                        temStr = temStr + "(正常)"
                    Case Is > 1
                        temStr = temStr + "(故障)"
                End Select
            Else
                temStr = temStr + "(待测)"
            End If
            temStr = temStr + "/后向网关:" + Format(rcFrame!endGate)
            If Not IsNull(rcFrame!EndGateStatus) Then
                Select Case rcFrame!EndGateStatus
                    Case 0
                        temStr = temStr + "(待测)"
                    Case 1
                        temStr = temStr + "(正常)"
                    Case Is > 1
                        temStr = temStr + "(故障)"
                End Select
            Else
                temStr = temStr + "(待测)"
            End If
            If Trim(Format(rcFrame!Date, "yyyy.m.d")) <> "" Then
                temStr = temStr + "/" + Format(rcFrame!Date, "yyyy.m.d")
            End If
            lstFrame.AddItem temStr
            rcFrame.MoveNext
        Loop
    End If
'status
    AppendStatusInfo "查看网络故障报告", icoBLUE
    SaveLog "查看网络故障报告", 0
    
End Sub

Private Sub Form_Resize()
lstFrame.Width = Me.Width - 320
lstBuild.Width = Me.Width - 320
lstUser.Width = Me.Width - 320
lstUser.Height = Me.Height - 3600
cmdOK.Top = Me.Height - 950
cmdOK.Left = Me.Width - 1500
cmdPrint.Top = Me.Height - 950
cmdPrint.Left = Me.Width - 2800
cmdGet.Top = Me.Height - 950
cmdGet.Left = Me.Width - 4100
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

Private Sub lstBuild_Click()
Dim temStr As String
Dim rcUser As Recordset
Dim curBuild As String
Dim curBuildStr As String

    lstUser.Clear
    Set rcUser = dbCbb.OpenRecordset("UserMap", dbOpenSnapshot)
    curBuildStr = Trim(lstBuild.List(lstBuild.ListIndex))
    If curBuildStr <> "" Then
        curBuild = Trim(Left(curBuildStr, InStr(1, curBuildStr, "(") - 1))
        lblUBuild = "公寓:" + Trim(curBuild)
        rcUser.FindFirst "trim(BuildID)=""" + curBuild + """" + " and Status>0 "
        Do While Not rcUser.NoMatch
            temStr = Format(rcUser!UserID) + "/" + Trim(rcUser!userName) + "/地址" + Format(rcUser!Address) + "/" + getUserStatusStr(rcUser!Status)
            If Trim(Format(rcUser!Date, "yyyy.m.d")) <> "" Then
                temStr = temStr + "/" + Format(rcUser!Date, "yyyy.m.d")
            End If
            lstUser.AddItem temStr
            rcUser.FindNext "trim(BuildID)=""" + curBuild + """" + " and Status>0 "
        Loop
    End If
    lstUser.Refresh
End Sub


Private Sub lstFrame_Click()
Dim temStr As String
Dim curFrameStr As String
Dim curFrameID As Integer
Dim rcBuild As Recordset

    lstBuild.Clear
    Set rcBuild = dbCbb.OpenRecordset("BuildMap", dbOpenSnapshot)
    curFrameStr = Trim(lstFrame.List(lstFrame.ListIndex))
    If curFrameStr <> "" Then
        curFrameID = Val(Left(curFrameStr, InStr(1, curFrameStr, "(") - 1))
        lblBGate = "网段:" + Format(curFrameID)
        If curFrameID <> 0 Then
            rcBuild.FindFirst "FrameID=" + Format(curFrameID)
            Do While Not rcBuild.NoMatch
                temStr = Trim(rcBuild!BuildID)
                If Not IsNull(rcBuild!Status) Then
                    Select Case rcBuild!Status
                        Case 0
                            temStr = temStr + "(待测)"
                        Case 1
                            temStr = temStr + "(正常)"
                        Case 2
                            temStr = temStr + "(故障)/安全器" + Format(rcBuild!Address) + "(故障)"
                        Case 3
                            temStr = temStr + "(故障)/终端器" + Format(rcBuild!Ender) + "(故障)"
                        Case Is > 3
                            temStr = temStr + "(故障)"
                    End Select
                Else
                    temStr = temStr + "(待测)"
                End If
                If Trim(Format(rcBuild!Date, "yyyy.m.d")) <> "" Then
                    temStr = temStr + "/" + Format(rcBuild!Date, "yyyy.m.d")
                End If
                lstBuild.AddItem temStr
                rcBuild.FindNext "FrameID=" + Format(curFrameID)
            Loop
        End If
    End If
    lstBuild.Refresh
End Sub




⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -