📄 frmrtdb_quantum_write.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form FrmRTDB_Quantum_write
Caption = "Write RTDB TO Quantum"
ClientHeight = 6030
ClientLeft = 60
ClientTop = 345
ClientWidth = 5220
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6030
ScaleWidth = 5220
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox Text2
Height = 375
Left = 1320
TabIndex = 6
Top = 5160
Width = 1935
End
Begin VB.TextBox Text3
Height = 390
Left = 4560
TabIndex = 4
Top = 5160
Width = 495
End
Begin VB.PictureBox Picture1
Align = 2 'Align Bottom
Appearance = 0 'Flat
BackColor = &H80000013&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Left = 0
ScaleHeight = 375
ScaleWidth = 5220
TabIndex = 1
Top = 5655
Width = 5220
Begin VB.CheckBox Check1
Caption = "点错误写入错误日志"
Height = 375
Left = 120
TabIndex = 8
Top = 0
Width = 2055
End
Begin VB.CommandButton CmdClose
Caption = "关闭(&C)"
Height = 330
Left = 3720
TabIndex = 3
Top = 0
Width = 975
End
Begin VB.CommandButton CmdTime
Caption = "时间(&T)"
Height = 330
Left = 2520
TabIndex = 2
Top = 0
Width = 975
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 1920
Top = 0
End
End
Begin MSFlexGridLib.MSFlexGrid DataGrid1
Height = 4920
Left = 0
TabIndex = 0
Top = 0
Width = 5220
_ExtentX = 9208
_ExtentY = 8678
_Version = 393216
End
Begin VB.Label Label2
Caption = "程序启动时间"
Height = 255
Left = 120
TabIndex = 7
Top = 5280
Width = 1095
End
Begin VB.Label Label1
Caption = "周期总耗时(S)"
Height = 255
Left = 3360
TabIndex = 5
Top = 5280
Width = 1215
End
End
Attribute VB_Name = "FrmRTDB_Quantum_write"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const Simulate = False '仿真变量:true =仿真模式
'---------------------------------------------------------------------------------------------
' 变量声明：与配置文件RTDB_QUANTUM.INI有关的全局变量
Public gi_rtdbtime As Long '写入时间间隔(分钟),可修改
Public gi_cimstime As Long '读对照表的时间间隔(小时),可修改
Public gi_zzcount As Integer '装置数量
Dim db_conn_info(1 To 3, 0 To 10) As String '配置信息存储位置
'---------------------------------------------------------------------------------------------
' 变量声明：与记录文件有关的全局对象
'---------------------------------------------------------------------------------------------
Dim Obj_FS As Object '文件系统对象
Dim Obj_LogFile As Object '文件对象，用于写入记录信息
Dim datLogFile As Date '日期变量，保存上次建立记录文件的时间(5天前)
'---------------------------------------------------------------------------------------------
' 变量声明：与Quantum数据库有关的全局对象
'---------------------------------------------------------------------------------------------
Dim ObjSession As QUANTUMAUTOMATIONLib.Session
Dim WithEvents ObjDataAccess As QUANTUMAUTOMATIONLib.QDataAccess
Attribute ObjDataAccess.VB_VarHelpID = -1
Dim ObjBrowser As QUANTUMAUTOMATIONLib.Browse2
Dim ObjQualityHelper As QUANTUMAUTOMATIONLib.QQualityHelper
Dim vItemID As Variant
Dim vValue As Variant
Dim lQuality As Long
'---------------------------------------------------------------------------------------------
' 变量声明：与各装置实时数据库有关的全局对象
'---------------------------------------------------------------------------------------------
Dim RTDB_CONN(1 To 10) As ADODB.Connection
Dim RTDB_RS(1 To 10) As ADODB.Recordset
'---------------------------------------------------------------------------------------------
' 变量声明：与对照表数据库有关的全局对象
'---------------------------------------------------------------------------------------------
Dim CIMS_CONN As ADODB.Connection
Dim CIMS_RS As ADODB.Recordset
Dim QUANTUM_CONN As ADODB.Connection
Dim QUANTUM_RS As ADODB.Recordset
'=============================================================================================
'=============================================================================================
'============================ 程序代码区 =======================================
'=============================================================================================
'=============================================================================================
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub CmdTime_Click()
FrmRTDB_Time.CimsText.Text = gi_cimstime '写入时间间隔(分钟)
FrmRTDB_Time.RtdbText.Text = gi_rtdbtime '读对照表的时间间隔(小时)
FrmRTDB_Time.Show vbModal
End Sub
'---------------------------------------------------------------------------------------------
'判断对象变量是否有引用
'---------------------------------------------------------------------------------------------
Private Function IsNothing(objCheck As Object) As Boolean
If TypeName(objCheck) = "Nothing" Then
IsNothing = True
Else
IsNothing = False
End If
End Function
'---------------------------------------------------------------------------------------------
'判断对象变量是否有引用且已经打开
'---------------------------------------------------------------------------------------------
Private Function IsOpen(objCheck As Object) As Boolean
If IsNothing(objCheck) Then
IsOpen = False
ElseIf objCheck.State <> adStateOpen Then
IsOpen = False
Else
IsOpen = True
End If
End Function
'---------------------------------------------------------------------------------------------
'清除对象引用并关闭连接
'---------------------------------------------------------------------------------------------
Private Sub ClearObject(objCLR As Object)
If Not IsNothing(objCLR) Then
If objCLR.State <> adStateClosed Then objCLR.Close
Set objCLR = Nothing
End If
End Sub
'---------------------------------------------------------------------------------------------
'执行结果处理
'---------------------------------------------------------------------------------------------
Private Sub RunResult(boolFlg As Boolean, strEvent As String, timInterval As Long)
Dim i As Long
If DataGrid1.Rows > 20 Then
DataGrid1.RemoveItem (1)
End If
If boolFlg Then
DataGrid1.AddItem "成功" & vbTab & strEvent & vbTab & Format(Now, "yyyy-mm-dd") + " " + Format(Time) & vbTab & timInterval
Else
DataGrid1.AddItem "！失败" & vbTab & strEvent & vbTab & Format(Now, "yyyy-mm-dd") + " " + Format(Time) & vbTab & timInterval
End If
DataGrid1.Refresh
End Sub
'---------------------------------------------------------------------------------------------
' 从配置文件RTDB_QUANTUM.INI中读入配置信息，包含
' RTDB数据库采样时间，标志为 "RTDBTIME"，存放在 gi_rtdbtime中，单位为分钟;
' CIMS即对照表数据库采样时间，标志为 "CIMSTIME"，存放在 gi_cimstime中，单位为小时;
' CIMS即对照表数据库的连接名称，标志为"ConnectName"，存放在 db_conn_info(1, 0)中;
' CIMS即对照表数据库的DSN名称，标志为"ODBCDSN"，存放在 db_conn_info(2, 0)中;
' 各个RTDB数据库的连接名称，标志为"ConnectNameX"，X为序号，存放在 db_conn_info(1, X)中;
' 各个RTDB数据库的DSN名称，标志为"ODBCDSNX"，X为序号，存放在 db_conn_info(2, X)中;
' 各个RTDB数据库的连接名称，标志为"ZZNameX"，X为序号，存放在 db_conn_info(3, X)中;
'---------------------------------------------------------------------------------------------
Private Function ReadConfiguration() As Boolean
Dim infile As Integer
Dim str0 As String, str1 As String, str2 As String
Dim Loc As Long, cnt As Integer
On Error GoTo READCONFIGURATIONERR
infile = FreeFile
Open "RTDB_QUANTUM.INI" For Input As #infile
While Not EOF(infile)
Line Input #infile, str0
Loc = InStr(1, str0, "=", vbTextCompare)
If Loc > 0 Then
str1 = LCase(Trim(Left(str0, Loc - 1)))
str2 = LCase(Trim(Mid(str0, Loc + 1)))
If Left(str1, 11) = "connectname" Then
If str1 = "connectname" Then
db_conn_info(1, 0) = str2
Else
cnt = CInt(Mid(str1, 12))
If cnt > gi_zzcount Then gi_zzcount = cnt
db_conn_info(1, cnt) = str2
End If
ElseIf Left(str1, 7) = "odbcdsn" Then
If str1 = "odbcdsn" Then
db_conn_info(2, 0) = str2
Else
cnt = CInt(Mid(str1, 8))
If cnt > gi_zzcount Then gi_zzcount = cnt
db_conn_info(2, cnt) = str2
End If
ElseIf Left(str1, 6) = "zzname" Then
cnt = CInt(Mid(str1, 7))
If cnt > gi_zzcount Then gi_zzcount = cnt
db_conn_info(3, cnt) = str2
ElseIf str1 = "cimstime" Then
gi_cimstime = CInt(str2)
If gi_cimstime < 1 Then gi_cimstime = 1
ElseIf str1 = "rtdbtime" Then
gi_rtdbtime = CInt(str2)
If gi_rtdbtime < 2 Then gi_rtdbtime = 2
End If
End If
Wend
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -