通过脚本及SQL数据库关联监听变量变化写入数据中库。
Function action
''''''''''''''''''''''''''''
Dim PlanSnNum
PlanSnNum = HMIRuntime.Tags("P_TK101_Job.PlanSnNum").Read
Dim OperateUser
OperateUser = HMIRuntime.Tags("P_TK101_Job.OperateUser").Read
''''''''''''''''''''''''''''
Dim PCName
PCName = HMIRuntime.Tags("@NOP::@ServerName").Read & "\WINCC"
Dim scon,conn
sCon="Driver={SQL Server};Server="&PCName&";Database=QDSJ_SCADA;UID=;PWD=;"
Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = sCon
conn.CursorLocation = 3
conn.Open
Dim ocom,oRs1,m,SQL1
Set oRs1 = CreateObject("ADODB.Recordset")
Set oCom = CreateObject("ADODB.Command")
oCom.CommandType = 1
Set oCom.ActiveConnection = conn
''''''''''''''''''''
Dim ArrTemp
'将表格中的内容全部读取到 ArrTemp二维数组中
SQL1 = "SELECT ID,CreateTime,EQPNumber,TankName,TankNumber,ObjectId,TagNumber,TagName,Description,PrevValue,PrevTimestamp,IsDelete,Remark FROM MonitorBase " &_
"WHERE IsDelete = '0'"
oCom.CommandText = SQL1
Set oRs1=oCom.Execute
m = oRs1.RecordCount
If m > 0 Then
Arrtemp = ors1.GetRows
End If
''''''''''''''''''''
'读取当前值
' 1. 先获取变量的名称
' 2. 读取变量的值
Dim RealValue(99)
Dim TagName,i
For i = 1 To UBound(ARRTemp,2) + 1
TagName = ARRTemp(7,i-1)
RealValue(i) = Trim(CStr(HMIRuntime.Tags(TagName).Read))
Next
'读取上一次的值(读取表中的PrevVlaue)
Dim PrevValue(99)
For i = 1 To UBound(ARRTemp,2) + 1
PrevValue(i) = Trim(CStr(ARRTemp(9,i-1)))
Next
''''''''''''''''''''''''''''
'当前值与PrevValue值比较
Dim UpdStr,UpdFinalStr,InsStr,InsFinalStr
UpdStr = "" : UpdFinalStr = ""
InsStr = "" : InsFinalStr = ""
Dim Desc
Desc = ""
''''''''''''''''''''''''''''
Dim SqlUpdEn
SqlUpdEn = 0
''''''''''''''''''''''''''''
For i = 1 To UBound(ARRTemp,2) + 1
If RealValue(i) <> PrevValue(i) Then
SqlUpdEn = 1
UpdStr = "UPDATE MonitorBase Set PrevValue = '"&RealValue(i)&"',PrevTimestamp = GETDATE() WHERE ID = '"&ARRTemp(0,i-1)&"'" & vbCrLf
UpdFinalStr = UpdFinalStr & UpdStr
''''''''''''''''''''''''''''
Select Case Trim(CStr(ARRTemp(5,i-1)))
Case "阀门"
InsStr = "(GETDATE(),'"&PlanSnNum&"','"&PlanSnNum&"','EQP01','溶胶罐A','TK001','"&OperateUser&"'," &_
"'"& ARRTemp(5,i-1)&"','"& ARRTemp(6,i-1)&"','"& ARRTemp(8,i-1)&"','"& RealValue(i)&"','"&PrevValue(i)&"','0','')," & vbCrLf
Case Else
InsStr = "(GETDATE(),'"&PlanSnNum&"','"&PlanSnNum&"','EQP01','溶胶罐A','TK001','"&OperateUser&"'," &_
"'"& ARRTemp(5,i-1)&"','"& ARRTemp(6,i-1)&"','"& ARRTemp(8,i-1)&"','"& FormatNumber(CStr(RealValue(i)),1)&"','"&FormatNumber(CStr(PrevValue(i)),1)&"','0','')," & vbCrLf
End Select
InsFinalStr = InsFinalStr & InsStr
End If
Next
'''''''''''''''''''''''''''''
InsFinalStr = "INSERT INTO Monitor(CreateTime,SnNum,PlanSnNum,EQPNumber,TankName,TankNumber,OperateUser,ObjectId,TagNumber,Description,NewValue,OldValue,IsDelete,Remark)Values" & vbCrLf & InsFinalStr
Dim FinalStr
FinalStr = ""
FinalStr = UpdFinalStr & InsFinalStr
SQL1 = ""
SQL1 = Left(FinalStr, Len(FinalStr) - Len(vbCrLf)-1)
' MsgBOX SQL1
''''''''''''''''''''''''''''
If SqlUpdEn = 1 Then
Dim Fs, File
Set Fs = CreateObject("Scripting.FileSystemObject")
Set File = Fs.OpenTextFile("C:\Users\Administrator\Desktop\AAA.txt",8, True)
File.WriteLine (SQL1)
File.Close
Set File = Nothing
Set Fs = Nothing
''''''''''''''''''''''''''''
oCom.CommandText = SQL1
Set oRs1 = oCom.Execute
End If
''''''''''''''''''''''''''''
Set oRs1 = Nothing
conn.Close
Set conn = Nothing
'''''''''''''''''''''
End Function