frmrtdb_quantum_write.frm

Oracle 数据库 与 Yokogawa Quantum 实时数据库接口

    
    Close #infile
    ReadConfiguration = True
       Exit Function
    
READCONFIGURATIONERR:
    MsgBox "不能打开配置文件 RTDB_QUANTUM.INI", vbOKOnly + vbCritical, "错误"
    ReadConfiguration = False
    
End Function

'---------------------------------------------------------------------------------------------
' 打开/创建记录文件。若文件已经打开则先关闭文件。文件名称取RTDB_Error_YYYYMMDD.LOG
'---------------------------------------------------------------------------------------------

Private Function OpenLogFile() As Boolean
    
    On Error Resume Next
    
    If Not IsNothing(Obj_LogFile) Then
        Obj_LogFile.Close
        Set Obj_LogFile = Nothing
    End If
    
    If IsNothing(Obj_FS) Then Set Obj_FS = CreateObject("Scripting.FileSystemObject")
    
    Set Obj_LogFile = Obj_FS.OpenTextFile("RTDB_Error_" + Format(Now, "yyyymmdd") + ".log", _
                                            8, 1)
    
    datLogFile = Date
    
    OpenLogFile = True
    Exit Function
    
OpenLogFileErr:
    OpenLogFile = False
        
End Function

'---------------------------------------------------------------------------------------------
' 初始化：
' 读入配置文件
' 打开记录文件
' 设置计时器开始工作
'---------------------------------------------------------------------------------------------

Private Sub Form_Load()
    
    gi_rtdbtime = 5  '缺省写入时间间隔(分钟)
    gi_cimstime = 12 '缺省读对照表的时间间隔(小时)
    gi_zzcount = 0   '缺省装置数量
  
    Text2.Text = Format(Now, "yyyy-mm-dd") + " " + Format(Time)
    
     With DataGrid1
        .Visible = False
        .BackColor = RGB(255, 255, 255):  .Rows = 1:      .Cols = 4:           .Row = 0
        .ColWidth(0) = 600: .ColWidth(1) = 1800: .ColWidth(2) = 1800: .ColWidth(3) = 600
        '.ColWidth(4) = 500: .ColWidth(5) = 500: .ColWidth(6) = 500: .ColWidth(7) = 500
        .TextMatrix(0, 0) = "结果"
        .TextMatrix(0, 1) = "  事  件  "
        .TextMatrix(0, 2) = "    时   间    "
        .TextMatrix(0, 3) = "耗时"
        '.TextMatrix(0, 4) = "读入点"
        '.TextMatrix(0, 5) = "写入点"
        '.TextMatrix(0, 6) = "无对照"
        '.TextMatrix(0, 7) = "无路经"
        .Visible = True
    End With
    
    '读取配置数据，得到连接数据库串、ODBC、装置名称，并放到数组中
    RunResult ReadConfiguration(), "读取配置信息", 1
        
    '打开错误文件，用于写入出错信息
    
    RunResult OpenLogFile(), "打开日志文件", 1
        
    '设置计时器, 由定时器触发开始执行数据处理
    Timer1.Interval = gi_rtdbtime * 1000
    Timer1.Enabled = True
End Sub

Private Sub Form_Terminate()
    Dim i As Integer
    
    If Not IsNothing(Obj_LogFile) Then
        Obj_LogFile.Close
        Set Obj_LogFile = Nothing
    End If
    
    Set Obj_FS = Nothing
    
    ClearObject CIMS_RS
    ClearObject CIMS_CONN
    
    Set ObjDataAccess = Nothing
    Set ObjBrowser = Nothing
    Set ObjSession = Nothing
    Set ObjQualityHelper = Nothing

    For i = 1 To 10
        ClearObject RTDB_RS(i)
        ClearObject RTDB_CONN(i)
    Next i
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Screen.MousePointer = vbDefault
End Sub

'---------------------------------------------------------------------------------------------
' 主程序在这里运行，步骤为 "重新打开对照表(如间隔到)" -> "重新连接Quantum数据库" -> "采集各RTDB"
' -> "写入Quantum数据库" -> "若对照表变化调整执行周期"
' 本计时器实际是分钟计时器,其Interval代表分钟
'---------------------------------------------------------------------------------------------

Private Sub Timer1_Timer()
    Dim i As Integer, CIMS_Changed_Flag As Boolean
    Dim BeginTime As Long, EndTime As Long, longMid As Long
    Static CIMS_Timer_count As Integer, Minute_Counter As Integer
    
    Timer1.Enabled = False
    On Error Resume Next
    
    'RTDB刷新时间计时
    If Minute_Counter Mod 60 <> 0 Then
        Minute_Counter = Minute_Counter + 1
        Timer1.Enabled = True
        If Minute_Counter < 60 Then Exit Sub
    End If
    
    Minute_Counter = 1
     
    BeginTime = Timer
    Screen.MousePointer = vbHourglass
    CIMS_Timer_count = CIMS_Timer_count + 1
    CIMS_Changed_Flag = False
    
    '保证 cims 连接有效
    If Not IsOpen(CIMS_CONN) Or Not IsOpen(CIMS_RS) Or _
        (CIMS_Timer_count > (gi_cimstime * 60 / gi_rtdbtime)) Then
        EndTime = Timer
        CIMS_Timer_count = 0
        CIMS_Changed_Flag = True
        
        If CIMS_Connect Then
            RunResult True, "读对照表", Timer - EndTime
        Else
            RunResult False, "读对照表", Timer - EndTime
            Timer1.Interval = 200
            Screen.MousePointer = vbArrow
            Timer1.Enabled = True
            Exit Sub
        End If
     End If
    
   
    '连接 Quantum 数据库
    If Simulate Then
        QConnect
    Else
    
        EndTime = Timer
        
        If Quantum_connect Then
            RunResult True, "Quantum连接", Timer - EndTime
        Else
            RunResult False, "Quantum连接", Timer - EndTime
            Timer1.Interval = 200
            Screen.MousePointer = vbArrow
            Timer1.Enabled = True
            Exit Sub
        End If
    End If
    '检索RTDB数据
    
    For i = 1 To gi_zzcount
        'Text1.Text = Format(Time) + " " + db_conn_info(1, i) + "/" + db_conn_info(2, i) + _
        '            "/" + db_conn_info(3, i)
        'Text1.Refresh
        If Not IsNull(db_conn_info(3, i)) And db_conn_info(3, i) <> "" Then
            EndTime = Timer
            RunResult RTDB_Connect(i), "连接" + db_conn_info(3, i), Timer - EndTime
            EndTime = Timer
            If TypeName(RTDB_RS(i)) <> "Nothing" Then
                If RTDB_RS(i).State = adStateOpen Then
                    WriteToQuantumFromRTDB (i)
                End If
            End If
            RunResult True, db_conn_info(3, i) + "写入Quantum", Timer - EndTime
            
          End If
    Next i
    
    EndTime = Timer
    
    Screen.MousePointer = vbArrow
    
    Text3 = Str(EndTime - BeginTime)
    Me.Refresh
    
     '修正间隔时间
    If CIMS_Changed_Flag Then
        'If (Timer1.Interval / 1000) < (EndTime - BeginTime) Then
        '    Timer1.Interval = (EndTime - BeginTime) * 1000 * 2 / 60
        'End If
        'gi_rtdbtime = Timer1.Interval / 1000
        'If gi_rtdbtime < 1 Then gi_rtdbtime = 1
        
       
              
    End If
    
    longMid = EndTime - BeginTime
    longMid = (gi_rtdbtime * 60) - longMid
    longMid = longMid * 1000 / 60
    
    If longMid < 500 Or longMid > 5000 Then
       Timer1.Interval = 500
    Else
       Timer1.Interval = longMid
    End If
    
    '重新打开错误信息文件，用于写入出错信息
    If DateDiff("d", datLogFile, Date) >= 2 Then
             RunResult OpenLogFile(), "打开日志文件", 1
    End If
    
    Timer1.Enabled = True
   
End Sub

'---------------------------------------------------------------------------------------------
' 按照对照表中XBZH内容寻找Quantum路径所需的点名字和属性.例如若某一栏中数据为
' "IU02" "FI-181" "JILIANG" "25:::PV 26:::SV 27:::MV 32:LCP-IFC-AC1:3:SUM 32:FIQ-181:11:PREDAY"
' 那么参数NameConv就是XBZH的内容,根据从RTDB数据库读取的记录构建Pattern，有两种可能：
' 1. 当前RTDB内容为 25 FI-181 0 0 ... 则生成 25:::作为Pattern,从NameConv中得到 .FI-181.PV.VALUE
' 2. 当前RTDB内容为 32 LCP-IFC-AC1 0 3 ...则生成 32:LCP-IFC-AC1:3:作为Pattern,从NameConv中
' 得到 .FI-181.SUM.PV
'---------------------------------------------------------------------------------------------

Private Function GetAttribute(Pattern As String, NameConv As Variant) As String

    Dim Loc As Long, Length As Long
    
    If IsNull(NameConv) Or NameConv = "" Then
        GetAttribute = ".PV.VALUE"
        Exit Function
    End If
    
    Loc = InStr(1, NameConv, Pattern)
    
    If NameConv = "" Or Loc <= 0 Then
        GetAttribute = ".PV.VALUE"
    Else
        Length = InStr(Loc, NameConv, " ") - Loc - Len(Pattern)
        If (Length <= 0) Then Length = 255
        Loc = Loc + Len(Pattern)
        GetAttribute = "." + Mid(NameConv, Loc, Length) + ".VALUE"
    End If

End Function

Private Sub WriteToQDatabase(QuantumPath As String, WriteValue As String)

    If QuantumPath = "" Then Exit Sub
    
    QUANTUM_RS.Find "qpath='" + QuantumPath + "'", 0, adSearchForward, adBookmarkFirst
    If QUANTUM_RS.EOF Then
        QUANTUM_RS.AddNew
        QUANTUM_RS!QPath = QuantumPath
    End If
    QUANTUM_RS!qvalue = WriteValue
    QUANTUM_RS.Update
    QUANTUM_RS.Requery
    
End Sub

'---------------------------------------------------------------------------------------------
'
'---------------------------------------------------------------------------------------------

Private Sub WriteToQuantumDatabase(QuantumPath As String, WriteValue As Variant)
    
    Dim Browser_RS As ADODB.Recordset

    On Error Resume Next
    
    'QuantumPath = "Root.ERYIBC.JILIANG.FQ-230.PV.Value"
    Set Browser_RS = ObjBrowser.PathToMetaData(QuantumPath, 1, brDetail)
    vItemID = Browser_RS!ItemID