pubfunc.bas

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

Attribute VB_Name = "pubFunc"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：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
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Sub ProcErr()
'Dim ErrLogFile As String
'Dim hFile As Integer
    'For Each Error In Errors
        MsgBox Err.Description, vbExclamation, "错误"
        'Open "log\" & ErrLogFile For Append As #hFile
        'Print #hFile, Err.Number & "   "; Err.sourse & "   " & Err.Description
        'Close #hFile
    'Next Error
End Sub
Sub initLstOP()
Dim rcOP As Recordset

    SQL = "select ID from OPMap "
    Set rcOP = dbCbb.OpenRecordset(SQL)
    frmOP.lstOP.Clear
    If rcOP.RecordCount > 0 Then
        Do While Not rcOP.EOF
            If Not IsNull(rcOP!id) Then
                frmOP.lstOP.AddItem Trim(rcOP!id)
            End If
            rcOP.MoveNext
        Loop
    End If
End Sub
Function GetLogFileName() As String
    GetLogFileName = Format(Date, "yyyymmdd") & ".log"
End Function
Sub SaveLog(LogString As String, Level As Integer)
Dim temLogFile As String
Dim hFile As Integer
    temLogFile = GetLogFileName
    hFile = FreeFile
    Open App.Path & "\log\" & temLogFile For Append As #hFile
    Print #hFile, Format(Time, "hh:nn:ss") & "  " & Level & "  " & LogString
    Close #hFile
End Sub
Sub AppendStatusInfo(StatusString As String, icoIndex As Integer)
    Dim temItem As ListItem
    'If frmMainInfo.imgBack.Visible = True Then
        'With frmMainInfo
            '.lstStatus.Visible = True
            '.grdUserFee.Visible = True
            '.imgBack.Visible = False
        'End With
    'End If
    If BrowInfo = True Then
        Set temItem = frmMainInfo.lstStatus.ListItems.Add(, , StatusString, , icoIndex)
        temItem.SubItems(1) = Format(Date, "yyyy-mm-dd") & " " & Format(Time, "hh:nn:ss")
        Set frmMainInfo.lstStatus.SelectedItem = temItem
        temItem.EnsureVisible
    End If
End Sub
Sub getVallue(ByVal temStr As String, ByRef valName As String, ByRef vallue As String)
    If InStr(1, temStr, "=") > 0 Then
        valName = Trim(Left(temStr, InStr(1, temStr, "=") - 1))
        vallue = Trim(Right(temStr, Len(temStr) - InStr(1, temStr, "=")))
    End If
End Sub
Sub loadINI()
Dim fHandle As Integer
Dim temStr As String
Dim valName As String
Dim Value As String

'----------------------------------------------------------------
'default value
    BaseAddr = 768
    curBit = 4
    AutoDate = 0
    AutoTime = CDate("00:00:00")
    Auto_Manual = False
    gCurAutoShut = 1
    gCurAutoOpenLamp = 1
    gCurShutFee = 0
    gCurMinFee = 0
    gCollectType = 0
    
    gVideoBrightness = 5000
    gVideoContrast = 5000
    gVideoHue = 5000
    gVideoSaturation = 5000
    gVideoStandard = 1
    gVideoSource = 1
    gVideoShowDate = True
    gVideoShowDate = True
    gVideoShowTime = 100
    gVideoXDate = 0
    gVideoYDate = 220
    gVideoXTime = 130
    gVideoYTime = 220
    gVideoImageHeight = 240
    gVideoImageWidth = 320
    gVideoCapDelay = 15
    gCapRetryTimes = 2
    gVideoFrameRate = 25
'------------------------------------------------------
    If Dir(App.Path & "\cbb.ini", 0) = "" Then
        fHandle = FreeFile
        Open App.Path & "\cbb.ini" For Binary As #fHandle
        Close #fHandle
    End If
    fHandle = FreeFile
    Open App.Path & "\cbb.ini" For Input As #fHandle
    Do While Not EOF(fHandle)
        Line Input #fHandle, temStr
        getVallue temStr, valName, Value
        Select Case UCase(Trim(valName))
            Case "AUTO_DATE"
                AutoDate = Val(Trim(Value))
            Case "AUTO_TIME"
                AutoTime = CDate(Trim(Value))
            Case "BASE_ADDR"
                BaseAddr = Val(Trim(Value))
            Case "BIT"
                curBit = Val(Trim(Value))
            Case "AUTOOPENLAMP"
                gCurAutoOpenLamp = Val(Trim(Value))
            Case "AUTOSHUT"
                gCurAutoShut = Val(Trim(Value))
            Case "MINFEE"
                gCurMinFee = Val(Trim(Value))
            Case "SHUTFEE"
                gCurShutFee = Val(Trim(Value))
            Case "COLLECTTYPE"
                gCollectType = Val(Trim(Value))
            Case "AUTO_MANUAL"
                Auto_Manual = IIf(Val(Value) = 0, False, True)
                
            Case "VIDEO_BRIGHT"
                gVideoBrightness = Val(Trim(Value))
            Case "VIDEO_CONTRAST"
                gVideoContrast = Val(Trim(Value))
            Case "VIDEO_HUE"
                gVideoHue = Val(Trim(Value))
            Case "VIDEO_SATURATION"
                gVideoSaturation = Val(Trim(Value))
            Case "VIDEO_STANDARD"
                gVideoStandard = Val(Trim(Value))
            Case "VIDEO_SOURCE"
                gVideoSource = Val(Trim(Value))
            Case "VIDEO_SHOWDATE"
                gVideoShowDate = IIf(Val(Trim(Value)) = 0, False, True)
            Case "VIDEO_SHOWTIME"
                gVideoShowTime = IIf(Val(Trim(Value)) = 0, False, True)
            Case "VIDEO_XDATE"
                gVideoXDate = Val(Trim(Value))
            Case "VIDEO_YDATE"
                gVideoYDate = Val(Trim(Value))
            Case "VIDEO_XTIME"
                gVideoXTime = Val(Trim(Value))
            Case "VIDEO_YTIME"
                gVideoYTime = Val(Trim(Value))
            Case "VIDEO_IMGHEIGHT"
                gVideoImageHeight = Val(Trim(Value))
            Case "VIDEO_IMGWIDTH"
                gVideoImageWidth = Val(Trim(Value))
            Case "VIDEO_COLOR"
                gVideoColor = Val(Trim(Value))
            Case "VIDEO_CAPDELAY"
                gVideoCapDelay = Val(Trim(Value))
            Case "VIDEO_CAPWAIT"
                gVideoCapWait = Val(Trim(Value))
            Case "CAP_RETRYTIMES"
                gCapRetryTimes = Val(Trim(Value))
            Case "VIDEO_FRAMERATE"
                gVideoFrameRate = Val(Trim(Value))
        End Select
    Loop
    Close #fHandle
    gblnCollecting = False
End Sub
Sub SaveINI()
Dim fHandle As Integer
    fHandle = FreeFile
    Open App.Path & "\cbb.ini" For Output As #fHandle
        Print #fHandle, "BASE_ADDR=" + Format(BaseAddr)
        Print #fHandle, "BIT=" + Format(curBit)
        Print #fHandle, "AUTO_DATE=" + Format(AutoDate)
        Print #fHandle, "AUTO_TIME=" + Format(AutoTime, "hh:nn:ss")
        Print #fHandle, "AUTOOPENLAMP=" & gCurAutoOpenLamp
        Print #fHandle, "AUTOSHUT=" & gCurAutoShut
        Print #fHandle, "MINFEE=" & gCurMinFee
        Print #fHandle, "SHUTFEE=" & gCurShutFee
        Print #fHandle, "COLLECTTYPE=" & gCollectType
        Print #fHandle, "AUTO_MANUAL=" & IIf(Auto_Manual, 1, 0)
        Print #fHandle, "VIDEO_BRIGHT=" & gVideoBrightness
        Print #fHandle, "VIDEO_CONTRAST=" & gVideoContrast
        Print #fHandle, "VIDEO_HUE=" & gVideoHue
        Print #fHandle, "VIDEO_SATURATION=" & gVideoSaturation
        Print #fHandle, "VIDEO_STANDARD=" & gVideoStandard
        Print #fHandle, "VIDEO_SOURCE=" & gVideoSource
        Print #fHandle, "VIDEO_SHOWDATE=" & IIf(gVideoShowDate, 1, 0)
        Print #fHandle, "VIDEO_SHOWTIME=" & IIf(gVideoShowTime, 1, 0)
        Print #fHandle, "VIDEO_XDATE=" & gVideoXDate
        Print #fHandle, "VIDEO_YDATE=" & gVideoYDate
        Print #fHandle, "VIDEO_XTIME=" & gVideoXTime
        Print #fHandle, "VIDEO_YTIME=" & gVideoYTime
        Print #fHandle, "VIDEO_IMGHEIGHT=" & gVideoImageHeight
        Print #fHandle, "VIDEO_IMGWIDTH=" & gVideoImageWidth
        Print #fHandle, "VIDEO_COLOR=" & gVideoColor
        Print #fHandle, "VIDEO_CAPDELAY=" & gVideoCapDelay
        Print #fHandle, "VIDEO_CAPWAIT=" & gVideoCapWait
        Print #fHandle, "CAP_RETRYTIMES=" & gCapRetryTimes
        Print #fHandle, "VIDEO_FRAMERATE=" & gVideoFrameRate
    Close #fHandle
End Sub
Sub CheckAll()
Dim rcGateMap As Recordset
Dim rcBuildMap As Recordset
Dim isForward As Boolean
Dim curGate As Integer
Dim curFrame As Integer
Dim curBuild As String
Dim curBuildAddr As Integer
Dim curBuildEnder As Integer        '每楼内的总线终端器

    SQL = "select * from GateMap order by FrameID ASC "
    Set rcGateMap = dbCbb.OpenRecordset(SQL)
    Set rcBuildMap = dbCbb.OpenRecordset("BuildMap", dbOpenDynaset)
    isForward = True
    
    Do While True
        If isForward Then
            If rcGateMap.EOF Then           '检查有无有效的网段设置
                Exit Do
            End If
        Else
            If rcGateMap.BOF Then
                Exit Do
            End If
        End If

beginFrame:
'检查网段
        curFrame = rcGateMap!FrameID        '取得当前网段号
        If isForward Then
            curGate = rcGateMap!StartGate
            If curGate = 0 Then                     '如果网关地址为0,(说明网关被跳过),跳过网关检查
                rcGateMap.Edit
                rcGateMap!Status = 0
                rcGateMap!StartGateStatus = 0
                rcGateMap!EndGateStatus = 0
                rcGateMap!Date = Date
                rcGateMap.Update
                GoTo Gate_GoOn
            End If
            lbl1 = "打开网段" + Format(curFrame) + "前向网关" + Format(curGate)
        Else
            curGate = rcGateMap!endGate
            If curGate = 0 Then
                GoTo Gate_GoOn
            End If
            lbl1 = "打开网段" + Format(curFrame) + "后向网关" + Format(curGate)
        End If
        lbl2 = ""
        If openGate(curGate) Then                   '如果打开网关成功
            rcGateMap.Edit                          '将该网段状态标志置为正常
            rcGateMap!Statu = 1
            If isForward Then
                rcGateMap!StartGateStatus = 1       '标记前向网关状态为正常
            Else
                rcGateMap!EndGateStatus = 1         '标记后向网关状态为正常
            End If
            rcGateMap!Date = Date
            rcGateMap.Update
            
            lbl2 = "成功"
            lst.AddItem lbl1 + " " + lbl2

Gate_GoOn:
'检查楼内总线
'状态值:    NULL,0---未知状态
'           1--------正常
'           2--------故障(安全器故障)
'           3--------故障(终端器故障或总线故障)
            rcBuildMap.FindFirst "FrameID=" + Format(curFrame)
            Do While Not rcBuildMap.NoMatch
                curBuild = rcBuildMap!BuildID           '取得楼号
                curBuildAddr = rcBuildMap!Address       '取得安全器地址
                curBuildEnder = rcBuildMap!Ender        '取得终端器地址
                
                lbl1 = "打开" + Trim(curBuild) + "安全器" + Format(curBuildAddr)
                lbl2 = ""
'检查安全器
                If curBuildAddr = 0 Then        '如果安全器地址为0,跳过该安全器检查
                    rcBuildMap.Edit
                    rcBuildMap!Status = 0
                    rcBuildMap!Date = Date
                    rcBuildMap.Update
                    GoTo Build_GoOn
                End If
                temVal = openBuild(curBuildAddr)
                If Not temVal Then
                    rcBuildMap.Edit             '标记安全器状态为故障
                    rcBuildMap!Status = 2
                    rcBuildMap!Date = Date
                    rcBuildMap.Update
                Else
                    rcBuildMap.Edit             '标记安全器状态为正常
                    rcBuildMap!Date = Date
                    rcBuildMap!Status = 1
                    rcBuildMap.Update
                    
                    lbl2 = "成功"
                    lst.AddItem lbl1 + " " + lbl2
                    lbl1 = "打开" + Trim(curBuild) + "总线终端器" + Format(curBuildEnder)
                    lbl2 = ""
                    
Build_GoOn:
'检查总线终端器
                    If curBuildEnder = 0 Then
                        GoTo NextBuild
                    End If
                    temVal = OpenBuildEnder(curBuildEnder)
                    If temVal Then
                        rcBuildMap.Edit
                        rcBuildMap!Status = 1       '标记楼状态为正常
                        rcBuildMap!Date = Date
                        rcBuildMap.Update
                        
                        lbl2 = "成功"
                        lst.AddItem lbl1 + " " + lbl2
                        rcBuildMap.Edit
                        rcBuildMap!Status = 0
                        rcBuildMap!Date = Date
                        rcBuildMap.Update
                        lbl1 = "楼" + Trim(curBuild) + "内总线正常"
                        lbl2 = ""
                        lst.AddItem lbl1 + " " + lbl2
                    Else
                        rcBuildMap.Edit
                        rcBuildMap!Status = 3       '标记楼状态为故障
                        rcBuildMap!Date = Date
                        rcBuildMap.Update
                        
                        lbl2 = "失败"
                        lst.AddItem lbl1 + " " + lbl2
                        rcBuildMap.Edit
                        rcBuildMap!Status = 1
                        rcBuildMap!Date = Date
                        rcBuildMap.Update
                        lbl1 = "楼" + Trim(curBuild) + "内总线故障"
                        lbl2 = ""
                        lst.AddItem lbl1 + " " + lbl2
                    End If
                End If
                CloseBuild (curBuildAddr)            '关闭当前安全器
NextBuild:
                lbl1 = ""
                lbl2 = ""
                rcBuildMap.FindNext "FrameID=" + Format(curFrame)
                DoEvents