module.bas

WinCC 污水处理系统源程序.里面包含了许多VB6制作的功能组件.很有参考意义.

Attribute VB_Name = "Module"
Sub Main()

Dim MyServer As OPCServer
Dim MyGroups As OPCGroups
Dim MyGroup_Read As OPCGroup
Dim MyGroup_Write As OPCGroup
Dim MyItems_Read As OPCItems
Dim MyItems_Write As OPCItems
Dim ServerHandle() As Long
Dim Errors() As Long
Dim ClientHandles_Read(1 To 3) As Long
Dim ClientHandles_Write(1 To 7) As Long
Dim OPCItemsID_Read(1 To 3) As String
Dim OPCItemsID_Write(1 To 7) As String
Dim TimeArray(1 To 3) As Integer
Dim TimeString As String
Dim SendValue(1 To 7) As Variant

'OPC 的连接
Set MyServer = New OPCServer
MyServer.Connect "OPCServer.WinCC"

Set MyGroups = MyServer.OPCGroups
'分两个组，Group1从WinCC里面读数据，Group2向WinCC写数据
Set MyGroup_Read = MyGroups.Add("Group1")
Set MyGroup_Write = MyGroups.Add("Group2")

For i = 1 To 3
ClientHandles_Read(i) = i
Next i

For i = 1 To 7
ClientHandles_Write(i) = i + 3
Next i

OPCItemsID_Read(1) = "ReportYear"
OPCItemsID_Read(2) = "ReportMonth"
OPCItemsID_Read(3) = "ReportDay"

OPCItemsID_Write(1) = "PD_V_Medium"
OPCItemsID_Write(2) = "PD_V_Lowest"
OPCItemsID_Write(3) = "PD_V_Highest"
OPCItemsID_Write(4) = "PD_A_Medium"
OPCItemsID_Write(5) = "PD_A_Lowest"
OPCItemsID_Write(6) = "PD_A_Highest"
OPCItemsID_Write(7) = "PD_W_Total"

Set MyItems_Read = MyGroup_Read.OPCItems
MyItems_Read.AddItems 3, OPCItemsID_Read, ClientHandles_Read, ServerHandle, Errors

Set MyItems_Write = MyGroup_Write.OPCItems
MyItems_Write.AddItems 7, OPCItemsID_Write, ClientHandles_Write, ServerHandle, Errors

Dim receValue() As Variant '接收WinCC变量值
MyGroup_Read.SyncRead OPCCache, 3, ServerHandle, receValue, Errors

For i = LBound(receValue) To UBound(receValue)
TimeArray(i) = receValue(i)
Next i

str1$ = Right(Str(TimeArray(1)), 2)
str2$ = LTrim(Str(TimeArray(2)))
str3$ = LTrim(Str(TimeArray(3)))

TimeString = str1 + "-" + str2 + "-" + str3

query1$ = "SELECT * FROM PDE#HD#Report#PD_1V_Medium"
query2$ = "SELECT * FROM PDE#HD#Report#PD_1V_Lowest"
query3$ = "SELECT * FROM PDE#HD#Report#PD_1V_Highest"
query4$ = "SELECT * FROM PDE#HD#Report#PD_1A_Medium"
query5$ = "SELECT * FROM PDE#HD#Report#PD_1A_Lowest"
query6$ = "SELECT * FROM PDE#HD#Report#PD_1A_Highest"
query7$ = "SELECT * FROM PDE#HD#Report#PD_W_Sum"

SendValue(1) = GetTag(query1)
SendValue(2) = GetTag(query2)
SendValue(3) = GetTag(query3)
SendValue(4) = GetTag(query4)
SendValue(5) = GetTag(query5)
SendValue(6) = GetTag(query6)
SendValue(7) = GetTag(query7)

MyGroup_Write.SyncWrite 7, ServerHandle, SendValue, Errors

End Sub
Public Function GetTag(query As String) As Double

Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim reValue As Double

Set conn = New ADODB.Connection
'ODBC数据源名称 Water，用户 DBA,密码 SQL
conn.Open "Water", "DBA", "SQL"
Set rs = conn.Execute(query) '返回相应的记录集

Do While Not rs.EOF
str4$ = Left(rs.Fields(0).Value, 7)
If str4 = TimeString Then
reValue = rs.Fields(1).Value
End If

rs.MoveNext
Loop

GetTag = reValue

End Function