frmrtdb_quantum_write.frm

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

    If IsNull(vItemID) Then
        If Check1.Value = 1 Then
            Obj_LogFile.writeline "写错误, 路径无效:" + QuantumPath
        End If
    Else
        ' Use QualityHelper function to fetch raw quality definition
        If Not IsNull(WriteValue) Then
            If IsNumeric(WriteValue) = True Then '返回值为数字值
                vValue = CSng(WriteValue)
                lQuality = ObjQualityHelper.RawQuality(qdaQualityGood)
            ElseIf WriteValue = "停工" Then      '返回值为数字值
                vValue = CSng(0)
                lQuality = ObjQualityHelper.RawQuality(qdaQualityBad)
            Else
                '
            End If
            ObjDataAccess.WriteValue vValue, vItemID, lQuality
        End If
    End If
    
    Set Browser_RS = Nothing
    
End Sub

Private Function WriteToQuantumFromRTDB(num As Integer) As Boolean

    Dim str0 As String, str1 As String, str2 As String
    Dim QPath As String, EquipmentName As String, OmittedPoint As String
    Dim timCount As Long
    
    On Error Resume Next

    If Not IsOpen(RTDB_RS(num)) Then Exit Function
    
    EquipmentName = db_conn_info(3, num) '装置名称
    
    If CIMS_RS.RecordCount < 1 Then
       WriteToQuantumFromRTDB = False
       Exit Function
    End If
    
    CIMS_RS.Filter = "zzms = '" + EquipmentName + "'"
    CIMS_RS.Requery
    'CIMS_RS.Source = "SELECT * FROM [" + EquipmentName + "$] Order by ZZMS,gwh"
    'CIMS_RS.Open
    'CIMS_RS.Requery
    
    timCount = Timer
    RTDB_RS(num).MoveFirst
    
    While Not RTDB_RS(num).EOF And (Timer - timCount) < 500
    
    
        timCount = Timer
        OmittedPoint = ""
        
        If RTDB_RS(num)!occurrence = "0" Then
            str1 = RTDB_RS(num)!request_type + ":" + RTDB_RS(num)!tag_name + "::"
            str2 = RTDB_RS(num)!request_type + ":::"
        Else
            str1 = RTDB_RS(num)!request_type + ":" + RTDB_RS(num)!tag_name + ":" + _
                    RTDB_RS(num)!occurrence + ":"
            str2 = RTDB_RS(num)!request_type + "::" + RTDB_RS(num)!occurrence + ":"
        End If
        
        CIMS_RS.MoveFirst
        CIMS_RS.Find "gwh ='" + RTDB_RS(num)!tag_name + "'", 0, adSearchForward, _
                    adBookmarkFirst
        
        If CIMS_RS.EOF <> True Then ' 有工位号
            QPath = "Root." + EquipmentName + "." + CIMS_RS!lxms + "." + _
                RTDB_RS(num)!tag_name + GetAttribute(str2, CIMS_RS!xbzh)
            OmittedPoint = RTDB_RS(num)!tag_name
            If Simulate Then
                WriteToQDatabase QPath, RTDB_RS(num)!return_value
            Else
                WriteToQuantumDatabase QPath, RTDB_RS(num)!return_value
            End If
        End If
        
        CIMS_RS.MoveFirst
        CIMS_RS.Find "xbzh like '*" + str1 + "*'", 0, adSearchForward, adBookmarkFirst
        
        While Not CIMS_RS.EOF
            QPath = "Root." + EquipmentName + "." + CIMS_RS!lxms + "." + _
                CIMS_RS!gwh + GetAttribute(str1, CIMS_RS!xbzh)
            OmittedPoint = CIMS_RS!gwh
            If Simulate Then
                WriteToQDatabase QPath, RTDB_RS(num)!return_value
            Else
                WriteToQuantumDatabase QPath, RTDB_RS(num)!return_value
            End If
            CIMS_RS.Find "xbzh like '*" + str1 + "*'", 1, adSearchForward, adBookmarkCurrent
        Wend
        
        
        '没有对照的点写入日志文件
        If Check1.Value = 1 Then
            If OmittedPoint = "" Then
                Obj_LogFile.writeline "装置：" + db_conn_info(3, num) + _
                            " 无对照的采集点：" + RTDB_RS(num)!tag_name
            End If
        End If
    
        RTDB_RS(num).MoveNext
    Wend
    
    If Not RTDB_RS(num).EOF Then
        WriteToQuantumFromRTDB = False
    Else
        WriteToQuantumFromRTDB = True
    End If
    
End Function

Private Function RTDB_Connect(num As Integer) As Boolean

    Dim IsConnect As Boolean
    Dim RTDB_CONN_String As String
    
    On Error GoTo RTDB_ConnectErr
    
    '连接RTDB数据
    RTDB_CONN_String = "PROVIDER=MSDASQL;dsn=" + db_conn_info(2, num) + _
                           ";uid=datagather;pwd=datagather;database=" + _
                           db_conn_info(1, num) + ";"
            
    IsConnect = False
    
    If IsOpen(RTDB_CONN(num)) And IsOpen(RTDB_RS(num)) Then
        RTDB_RS(num).Requery
        IsConnect = True
    Else '连接无效
        ClearObject RTDB_RS(num)
        ClearObject RTDB_CONN(num)
    End If
    
    If Not IsConnect Then
        Set RTDB_CONN(num) = New ADODB.Connection
        RTDB_CONN(num).ConnectionString = RTDB_CONN_String
        RTDB_CONN(num).ConnectionTimeout = 30
        RTDB_CONN(num).CursorLocation = adUseClient
        RTDB_CONN(num).Open RTDB_CONN_String

        Set RTDB_RS(num) = New ADODB.Recordset
        Set RTDB_RS(num).ActiveConnection = RTDB_CONN(num)
        RTDB_RS(num).CursorLocation = adUseClient
        RTDB_RS(num).LockType = adLockOptimistic
        RTDB_RS(num).CursorType = adOpenKeyset
        RTDB_RS(num).Source = "select tag_name,return_value,to_char(request_type) " & _
            "request_type , to_char(occurrence) occurrence from tag_all order by tag_name"
        RTDB_RS(num).Open
    End If
    RTDB_Connect = True
    Exit Function
    
RTDB_ConnectErr:
    Obj_LogFile.writeline "--------------------------------------------------------------"
    Obj_LogFile.writeline "错误时间：" + Format(Now, "yyyy-mm-dd") + "  " + Format(Time)
    Obj_LogFile.writeline "错误原因：ConnectName=" + db_conn_info(1, num) + "    ODBCDSN=" + _
                    db_conn_info(2, num) + "    ZZName=" + db_conn_info(3, num) + "无法连接!"
    Obj_LogFile.writeline "错误信息：" + Err.Description
    
    RTDB_Connect = False

End Function

Private Function CIMS_Connect() As Boolean
    
    Dim CIMS_CONN_String As String
    
    On Error GoTo CIMS_ConnectErr
    
    '连接cims数据库
    'CIMS_CONN_String = "PROVIDER=MSDASQL;dsn=" + db_conn_info(2, 0) + _
    '                       ";uid=cims;pwd=jzcims;database=" + db_conn_info(1, 0) + ";"  '从5500机器上得到对照表
    '    从Access 连接
    'CIMS_CONN_String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + CurDir() + "\" + db_conn_info(2, 0) + ";Persist Security Info=False"
        
    ' 从Excel 连接
    CIMS_CONN_String = "Provider=Microsoft.Jet.OLEDB.4.0;" + "Data Source=" + CurDir() + "\" + db_conn_info(2, 0) + ";Extended Properties=Excel 8.0;"

    
    ClearObject CIMS_RS
    ClearObject CIMS_CONN
    
    Set CIMS_CONN = New ADODB.Connection
    CIMS_CONN.ConnectionString = CIMS_CONN_String
    CIMS_CONN.ConnectionTimeout = 30
    CIMS_CONN.CursorLocation = adUseClient
    CIMS_CONN.Open CIMS_CONN_String
    
    If CIMS_CONN.State <> adStateOpen Then GoTo CIMS_ConnectErr
    
    Set CIMS_RS = New ADODB.Recordset
    Set CIMS_RS.ActiveConnection = CIMS_CONN
    CIMS_RS.CursorLocation = adUseClient
    CIMS_RS.LockType = adLockOptimistic
    CIMS_RS.CursorType = adOpenKeyset
    'CIMS_RS.Source = "select ZZMS,GWH,LXMS,XBZH from RTDB_QUANTUM Order by ZZMS,gwh"
    CIMS_RS.Source = "SELECT * FROM [TOTAL$] Order by ZZMS,gwh"
    CIMS_RS.Open
    
    CIMS_Connect = True
    Exit Function
    
CIMS_ConnectErr:
    Obj_LogFile.writeline "--------------------------------------------------------------"
    Obj_LogFile.writeline "错误时间：" + Format(Now, "yyyy-mm-dd") + "  " + Format(Time)
    Obj_LogFile.writeline "错误原因：ConnectName=" + db_conn_info(1, 0) + "    ODBCDSN=" + _
                            db_conn_info(2, 0) + "无法连接!"
    Obj_LogFile.writeline "错误信息：" + Err.Description
    
    DataGrid1.BackColor = Rnd() * 1000000
    
    CIMS_Connect = False

End Function

Private Function Quantum_connect() As Boolean

    On Error GoTo Quantum_connectErr
    
    Set ObjDataAccess = Nothing: Set ObjBrowser = Nothing
    Set ObjSession = Nothing:    Set ObjQualityHelper = Nothing
    
    Set ObjSession = New QUANTUMAUTOMATIONLib.Session
    Set ObjQualityHelper = New QUANTUMAUTOMATIONLib.QQualityHelper
    Set ObjBrowser = ObjSession.Browser
    Set ObjDataAccess = New QUANTUMAUTOMATIONLib.QDataAccess
    ObjDataAccess.SetSession ObjSession
    
    'Text1.BackColor = RGB(255, 255, 255)
    Quantum_connect = True
    Exit Function

Quantum_connectErr:
    Obj_LogFile.writeline "Quantum 数据库连接错误! 错误时间：" & _
                        Format(Now, "yyyy-mm-dd") + "  " + Format(Time)
    'Text1.BackColor = Rnd() * 1000000
    Quantum_connect = False

End Function

'============================================================================================
'Quantum 数据库操作出错处理例程
'--------------------------------------------------------------------------------------------

Private Sub objDataAccess_OnError(ByVal Number As Long, ByVal Description As String, _
                ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long)
    
Obj_LogFile.writeline "Quantum 数据库 DataAccess OnError() 错误捕获. 错误号: " & CStr(Number) & _
        " 描述: " & Description & " 源:- " & Source & " 帮助文件:- " & _
        HelpFile & " 帮助上下文:- " & CStr(HelpContext)
    
End Sub

Private Sub QConnect()
    
    On Error GoTo Q_ConnectErr
    
    If TypeName(QUANTUM_RS) <> "Nothing" Then
        If TypeName(QUANTUM_RS.ActiveConnection) <> "Nothing" Then
            Set QUANTUM_RS.ActiveConnection = Nothing
        End If
        If QUANTUM_RS.State <> adStateClosed Then QUANTUM_RS.Close
        Set QUANTUM_RS = Nothing
    End If
    
    If CIMS_CONN.State <> adStateOpen Then GoTo Q_ConnectErr
        
    Set QUANTUM_RS = New ADODB.Recordset
    Set QUANTUM_RS.ActiveConnection = CIMS_CONN
    QUANTUM_RS.CursorLocation = adUseClient
    QUANTUM_RS.LockType = adLockOptimistic
    QUANTUM_RS.CursorType = adOpenKeyset
    QUANTUM_RS.Source = "select qpath,qvalue from QUANTUM"
    QUANTUM_RS.Open
    
    'Text1.BackColor = RGB(255, 255, 255)
    
    Exit Sub
    
Q_ConnectErr:
    
    Obj_LogFile.writeline "Quantum 数据库连接错误! 错误时间：" & _
                        Format(Now, "yyyy-mm-dd") + "  " + Format(Time)
    'Text1.BackColor = Rnd() * 1000000

End Sub