猫史档案馆


连点器代码

用户:HJS_abaabaHJS_abaaba查看:9 回复:2 评论:9 创建时间:2020-06-19T16:14:47


VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPHD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private objPHDServer As Object, objPHDMiddle As Object

Public Function Connect() As Boolean
    On Error GoTo ErrorHandler

    Set objPHDServer = CreateObject("VisualPHD.Data")
    Set objPHDMiddle = CreateObject("VisualPHD.Data")
    
    objPHDServer.HostName = "L1RTDB"
    objPHDServer.MinimumConfidence = 0
    objPHDServer.ReductionOffset = "After"
    objPHDServer.SampleMethod = "InterpolateRaw"


    objPHDMiddle.HostName = "APP55"
    objPHDMiddle.MinimumConfidence = 0
    objPHDServer.ReductionOffset = "After"
    objPHDMiddle.SampleMethod = "InterpolateRaw"

    Connect = True
    Exit Function

ErrorHandler:

    objUtility.LogWriteError "PHD.Connect() " & Err.Description
    Err.Clear

    Connect = False
    Exit Function
End Function

Public Sub Disconnect()
    Set objPHDServer = Nothing
    Set objPHDMiddle = Nothing
End Sub

Public Function GetValue(sTag As String, sStartTime As String, sEndTime As String, vValue As Variant, vConfidence As Variant) As Boolean
    Dim dtFrom As Date, dtTo As Date
    dtFrom = ParseTimeRomys2VB(sStartTime)
    dtTo = ParseTimeRomys2VB(sEndTime)

    If dtFrom = dtTo Then
        dtFrom = DateAdd("s", -60, dtTo)
    End If

    If GetValueFromServer(objPHDServer, dtFrom, dtTo, sTag, vValue, vConfidence) Then
        GetValue = True
    Else
        objUtility.LogWrite "S1RTDB - Low Confidence [" & sTag & "|" & CStr(dtFrom) & "|" & CStr(dtTo) & "|" & CStr(vConfidence) & "%]"
        Dim vValue2 As Variant, vConfidence2 As Variant
        If GetValueFromServer(objPHDMiddle, dtFrom, dtTo, sTag, vValue2, vConfidence2) Then
            vValue = vValue2
            vConfidence = vConfidence2
            GetValue = True
        Else
            objUtility.LogWrite "OFFAPP - Low Confidence [" & sTag & "|" & CStr(dtFrom) & "|" & CStr(dtTo) & "|" & CStr(vConfidence2) & "%]"
            If CDbl(vConfidence) < CDbl(vConfidence2) Then
                vValue = vValue2
                vConfidence = vConfidence2
                GetValue = False
            End If
        End If
    End If
End Function

Private Function GetValueFromServer(objPHD As Object, dtFrom As Date, dtTo As Date, sTag As String, vValue As Variant, vConfidence As Variant) As Boolean
    On Error GoTo ErrorHandler
    
    objPHD.StartTime = Format(dtFrom, "yyyy-mm-dd hh:mm:ss")
    objPHD.EndTime = Format(dtTo, "yyyy-mm-dd hh:mm:ss")
    
    objPHD.Tags.Add sTag
    objPHD.Tags(sTag).ReductionType = "Average"
    
    objPHD.OverallReductionsOnly = True
    
    objPHD.Fetch
    
    vValue = objPHD.Tags(sTag).Value(True)
    vConfidence = objPHD.Tags(sTag).Confidence(True)

    objPHD.Tags.RemoveAll

    GetValueFromServer = CDbl(vConfidence) > 90

    Exit Function

ErrorHandler:

    objUtility.LogWriteError "GetValueFromServer() " & Err.Description & " [" & objPHD.HostName & "|" & sTag & "|" & CStr(dtFrom) & "|" & CStr(dtTo) & "]"
    Err.Clear

    Disconnect
    Connect

    vValue = 0
    vConfidence = 0

    GetValueFromServer = False

    Exit Function
End Function

Private Function ParseTimeRomys2VB(ByVal sTime As String) As Date
'31-Oct-02 17:40:00
'123456789012345678

    On Error GoTo ErrorHandler

    Dim iYe As Integer, iMo As Integer, iDa As Integer, iHo As Integer, iMi As Integer, iSe As Integer
    
    iYe = CInt(Mid(sTime, 8, 2))
    Select Case UCase(Mid(sTime, 4, 3))
        Case "JAN"
            iMo = 1
        Case "FEB"
            iMo = 2
        Case "MAR"
            iMo = 3
        Case "APR"
            iMo = 4
        Case "MAY"
            iMo = 5
        Case "JUN"
            iMo = 6
        Case "JUL"
            iMo = 7
        Case "AUG"
            iMo = 8
        Case "SEP"
            iMo = 9
        Case "OCT"
            iMo = 10
        Case "NOV"
            iMo = 11
        Case Else
            iMo = 12
    End Select
    iDa = CInt(Left(sTime, 2))
    iHo = CInt(Mid(sTime, 11, 2))
    iMi = CInt(Mid(sTime, 14, 2))
    iSe = CInt(Mid(sTime, 17, 2))

    ParseTimeRomys2VB = DateSerial(iYe, iMo, iDa) + TimeSerial(iHo, iMi, iSe)
    
    Exit Function

ErrorHandler:

    objUtility.LogWriteError "ParseTimeRomys2VB() " & sTime & " - " & Err.Description
    Err.Clear

    ParseTimeRomys2VB = Now

    Exit Function
End Function


回复

上一页1 页 / 共 1下一页
一块软糖一块软糖

666

点赞0


评论


ASW工业ASW工业

这是AndLua?

点赞0


评论