module1.bas

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

Attribute VB_Name = "Module1"
Dim AnOPCServer As OPCServer
Dim AnOPCGroups As OPCGroups
Dim RecvOPCGroup As OPCGroup
Dim SendOPCGroup As OPCGroup
Dim RecvOPCItems As OPCItems
Dim SendOPCItems As OPCItems
Dim ServerHandle() As Long
Dim ServerError() As Long
Dim RecvOPCItemIDs(1 To 2) As String
Dim SendOPCItemIDs(1 To 10) As String
Dim RecvClientHandles(1 To 2) As Long
Dim SendClientHandles(1 To 10) As Long

Sub main()

'OPC初始化//////////////////////////////
Set AnOPCServer = New OPCServer
AnOPCServer.Connect "OPCServer.WinCC"

Set AnOPCGroups = AnOPCServer.OPCGroups
Set RecvOPCGroup = AnOPCGroups.Add("rece")
Set SendOPCGroup = AnOPCGroups.Add("send")

RecvOPCItemIDs(1) = "BeginTime"
RecvOPCItemIDs(2) = "EndTime"

SendOPCItemIDs(1) = "BeginYear"
SendOPCItemIDs(2) = "BeginMonth"
SendOPCItemIDs(3) = "BeginDay"
SendOPCItemIDs(4) = "BeginHour"
SendOPCItemIDs(5) = "BeginMinute"
SendOPCItemIDs(6) = "EndYear"
SendOPCItemIDs(7) = "EndMonth"
SendOPCItemIDs(8) = "EndDay"
SendOPCItemIDs(9) = "EndHour"
SendOPCItemIDs(10) = "EndMinute"

For i = 1 To 2
RecvClientHandles(i) = i
Next i

For i = 1 To 10
SendClientHandles(i) = i + 2
Next i

Set RecvOPCItems = RecvOPCGroup.OPCItems
RecvOPCItems.AddItems 2, RecvOPCItemIDs, RecvClientHandles, ServerHandle, ServerError

Set SendOPCItems = SendOPCGroup.OPCItems
SendOPCItems.AddItems 10, SendOPCItemIDs, SendClientHandles, ServerHandle, ServerError
'OPC初始化结束//////////////////////////////

Dim RecvVal() As Variant
Dim BeginTime(1 To 5) As String
Dim EndTime(1 To 5) As String
Dim pos1
Dim pos2

'读入开始、结束时间
RecvOPCGroup.SyncRead OPCCache, 2, ServerHandle, RecvVal, ServerError
'处理开始时间
BeginTime(1) = Left(RecvVal(1), 2)
BeginTime(1) = "20" + BeginTime(1)

BeginTime(2) = Mid(RecvVal(1), 4, 2)
BeginTime(2) = Str(Val(BeginTime(2)))

pos1 = InStr(1, RecvVal(1), " ")
BeginTime(3) = Mid(RecvVal(1), pos1 - 2, 2)

pos2 = pos1 + 1
If Mid(RecvVal(1), pos2, 2) = "上午" Then
    pos2 = pos1 + 4
    BeginTime(4) = Mid(RecvVal(1), pos2, 2)
ElseIf Mid(RecvVal(1), pos2, 2) = "下午" Then
    pos2 = pos1 + 4
    BeginTime(4) = Str(Val(Mid(RecvVal(1), pos2, 2)) + 12)
End If

pos2 = pos1 + 7
BeginTime(5) = Mid(RecvVal(1), pos2, 2)

'处理结束时间
EndTime(1) = Left(RecvVal(2), 2)
EndTime(1) = "20" + EndTime(1)

EndTime(2) = Mid(RecvVal(2), 4, 2)
EndTime(2) = Str(Val(EndTime(2)))

pos1 = InStr(1, RecvVal(2), " ")
EndTime(3) = Mid(RecvVal(2), pos1 - 2, 2)

pos2 = pos1 + 1
If Mid(RecvVal(2), pos2, 2) = "上午" Then
    pos2 = pos1 + 4
    EndTime(4) = Mid(RecvVal(2), pos2, 2)
ElseIf Mid(RecvVal(2), pos2, 2) = "下午" Then
    pos2 = pos1 + 4
    EndTime(4) = Str(Val(Mid(RecvVal(2), pos2, 2)) + 12)
End If

pos2 = pos1 + 7
EndTime(5) = Mid(RecvVal(2), pos2, 2)

Dim SendVal(1 To 10) As Variant
For i = 1 To 5
SendVal(i) = Val(BeginTime(i))
SendVal(i + 5) = Val(EndTime(i))
Next i
'发送处理完的结果
SendOPCGroup.SyncWrite 10, ServerHandle, SendVal, ServerError

End Sub