form1.frm

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

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "PLC4"
   ClientHeight    =   2415
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3150
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2415
   ScaleWidth      =   3150
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Interval        =   2000
      Left            =   1050
      Top             =   735
   End
   Begin MSCommLib.MSComm MSComm 
      Left            =   2100
      Top             =   840
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   0   'False
      InBufferSize    =   16
      InputLen        =   16
      BaudRate        =   4800
      InputMode       =   1
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim MyServer As OPCServer
Attribute MyServer.VB_VarHelpID = -1
Dim MyGroups As OPCGroups
Attribute MyGroups.VB_VarHelpID = -1
Dim MyGroup_DigitalWrite As OPCGroup
Attribute MyGroup_DigitalWrite.VB_VarHelpID = -1
Dim MyGroup_AnalogWrite As OPCGroup
Attribute MyGroup_AnalogWrite.VB_VarHelpID = -1
Dim MyGroup_DigitalRead As OPCGroup
Dim MyGroup_AnalogRead As OPCGroup

Dim MyItems_DigitalWrite As OPCItems
Dim MyItems_AnalogWrite As OPCItems
Dim MyItems_DigitalRead As OPCItems
Dim MyItems_AnalogRead As OPCItems

Dim ServerHandle() As Long
Dim Errors() As Long

Dim ClientHandles_DigitalWrite(1 To 25) As Long
Dim ClientHandles_AnalogWrite(1 To 3) As Long
Dim ClientHandles_DigitalRead(1 To 18) As Long
Dim ClientHandles_AnalogRead(1 To 7) As Long

Dim OPCItemsID_DigitalWrite(1 To 25) As String
Dim OPCItemsID_AnalogWrite(1 To 3) As String
Dim OPCItemsID_DigitalRead(1 To 18) As String
Dim OPCItemsID_AnalogRead(1 To 7) As String


Dim receArray(1 To 16) As Byte
Dim sendArray(1 To 21) As Byte
Dim DigitalWrite(1 To 25) As Variant
Dim AnalogWrite(1 To 3) As Variant
Dim DigitalRead(1 To 18) As Byte
Dim AnalogRead(1 To 7) As Integer

Dim DigitalValue() As Variant   '从WinCC接收数字量
Dim AnalogValue() As Variant   '从WinCC接收模拟量
Dim temBool(1 To 8) As Boolean
Dim recValue() As Byte


Private Sub Form_Load()
'OPC初始化
Set MyServer = New OPCServer
MyServer.Connect "OPCServer.WinCC"

Set MyGroups = MyServer.OPCGroups

Set MyGroup_DigitalWrite = MyGroups.Add("Group1")
Set MyGroup_AnalogWrite = MyGroups.Add("Group2")
Set MyGroup_DigitalRead = MyGroups.Add("Group3")
Set MyGroup_AnalogRead = MyGroups.Add("Group4")

'写入WinCC的数字变量ItemID连接
OPCItemsID_DigitalWrite(1) = "WB_GSJ_Z"
OPCItemsID_DigitalWrite(2) = "WB_GSJ_K"
OPCItemsID_DigitalWrite(3) = "WB_GSJ_G"
OPCItemsID_DigitalWrite(4) = "WB_GSJ_O"

OPCItemsID_DigitalWrite(5) = "WB_1PWB_Z"
OPCItemsID_DigitalWrite(6) = "WB_1PWB_K"
OPCItemsID_DigitalWrite(7) = "WB_1PWB_G"
OPCItemsID_DigitalWrite(8) = "WB_1PWB_O"

OPCItemsID_DigitalWrite(9) = "WB_2PWB_Z"
OPCItemsID_DigitalWrite(10) = "WB_2PWB_K"
OPCItemsID_DigitalWrite(11) = "WB_2PWB_G"
OPCItemsID_DigitalWrite(12) = "WB_2PWB_O"

OPCItemsID_DigitalWrite(13) = "WB_3PWB_Z"
OPCItemsID_DigitalWrite(14) = "WB_3PWB_K"
OPCItemsID_DigitalWrite(15) = "WB_3PWB_G"
OPCItemsID_DigitalWrite(16) = "WB_3PWB_O"

OPCItemsID_DigitalWrite(17) = "WB_4PWB_Z"
OPCItemsID_DigitalWrite(18) = "WB_4PWB_K"
OPCItemsID_DigitalWrite(19) = "WB_4PWB_G"
OPCItemsID_DigitalWrite(20) = "WB_4PWB_O"

OPCItemsID_DigitalWrite(21) = "WB_YZJ_Z"
OPCItemsID_DigitalWrite(22) = "WB_YZJ_K"
OPCItemsID_DigitalWrite(23) = "WB_YZJ_G"
OPCItemsID_DigitalWrite(24) = "WB_YZJ_O"

OPCItemsID_DigitalWrite(25) = "WB_DY_K"


'写入WinCC的模拟变量ItemID连接
OPCItemsID_AnalogWrite(1) = "WB_L"
OPCItemsID_AnalogWrite(2) = "WB_DL"
OPCItemsID_AnalogWrite(3) = "WB_PH"

'从WinCC读数字变量ItemID连接
OPCItemsID_DigitalRead(1) = "WB_GSJ_Y"
OPCItemsID_DigitalRead(2) = "WB_GSJ_M"
OPCItemsID_DigitalRead(3) = "WB_GSJ_T"

OPCItemsID_DigitalRead(4) = "WB_1PWB_Y"
OPCItemsID_DigitalRead(5) = "WB_1PWB_M"
OPCItemsID_DigitalRead(6) = "WB_1PWB_T"

OPCItemsID_DigitalRead(7) = "WB_2PWB_Y"
OPCItemsID_DigitalRead(8) = "WB_2PWB_M"
OPCItemsID_DigitalRead(9) = "WB_2PWB_T"

OPCItemsID_DigitalRead(10) = "WB_3PWB_Y"
OPCItemsID_DigitalRead(11) = "WB_3PWB_M"
OPCItemsID_DigitalRead(12) = "WB_3PWB_T"

OPCItemsID_DigitalRead(13) = "WB_4PWB_Y"
OPCItemsID_DigitalRead(14) = "WB_4PWB_M"
OPCItemsID_DigitalRead(15) = "WB_4PWB_T"

OPCItemsID_DigitalRead(16) = "WB_YZJ_Y"
OPCItemsID_DigitalRead(17) = "WB_YZJ_M"
OPCItemsID_DigitalRead(18) = "WB_YZJ_T"

'从WinCC读模拟变量ItemID连接
OPCItemsID_AnalogRead(1) = "WB_DL_H"
OPCItemsID_AnalogRead(2) = "WB_DL_L"
OPCItemsID_AnalogRead(3) = "WB_YW_H"
OPCItemsID_AnalogRead(4) = "WB_1YW"
OPCItemsID_AnalogRead(5) = "WB_2YW"
OPCItemsID_AnalogRead(6) = "WB_3YW"
OPCItemsID_AnalogRead(7) = "Option_WB"

For i = 1 To 25
ClientHandles_DigitalWrite(i) = i
Next i

For i = 1 To 3
ClientHandles_AnalogWrite(i) = i + 25
Next i

For i = 1 To 18
ClientHandles_DigitalRead(i) = 28
Next i

For i = 1 To 7
ClientHandles_AnalogRead(i) = i + 46
Next i

Set MyItems_DigitalWrite = MyGroup_DigitalWrite.OPCItems
Set MyItems_AnalogWrite = MyGroup_AnalogWrite.OPCItems
Set MyItems_DigitalRead = MyGroup_DigitalRead.OPCItems
Set MyItems_AnalogRead = MyGroup_AnalogRead.OPCItems

MyItems_AnalogRead.AddItems 7, OPCItemsID_AnalogRead, ClientHandles_AnalogRead, ServerHandle, Errors
MyItems_DigitalRead.AddItems 18, OPCItemsID_DigitalRead, ClientHandles_DigitalRead, ServerHandle, Errors
MyItems_AnalogWrite.AddItems 3, OPCItemsID_AnalogWrite, ClientHandles_AnalogWrite, ServerHandle, Errors
MyItems_DigitalWrite.AddItems 25, OPCItemsID_DigitalWrite, ClientHandles_DigitalWrite, ServerHandle, Errors

'打开通讯端口
MSComm.PortOpen = True
'隐藏窗体
Form1.Visible = False

End Sub

Private Sub Form_Unload(Cancel As Integer)
MSComm.PortOpen = False
MyServer.Disconnect

End Sub



Private Sub Timer1_Timer()
'处理接收

'接收
recValue = MSComm.Input
'清空缓冲区
MSComm.InBufferCount = 0
For i = LBound(recValue) To UBound(recValue)
   receArray(i + 1) = recValue(i)
Next i

If receArray(8) = 254 And receArray(9) = 254 And receArray(10) = 254 Then

'解析数字量字节，放入待发送数组
GetBit (receArray(1))
DigitalWrite(1) = temBool(1)
DigitalWrite(2) = temBool(2)
DigitalWrite(3) = temBool(3)
DigitalWrite(4) = temBool(4)

GetBit (receArray(2))
DigitalWrite(5) = temBool(1)
DigitalWrite(6) = temBool(2)
DigitalWrite(7) = temBool(3)
DigitalWrite(8) = temBool(4)

GetBit (receArray(3))
DigitalWrite(9) = temBool(1)
DigitalWrite(10) = temBool(2)
DigitalWrite(11) = temBool(3)
DigitalWrite(12) = temBool(4)

GetBit (receArray(4))
DigitalWrite(13) = temBool(1)
DigitalWrite(14) = temBool(2)
DigitalWrite(15) = temBool(3)
DigitalWrite(16) = temBool(4)

GetBit (receArray(5))
DigitalWrite(17) = temBool(1)
DigitalWrite(18) = temBool(2)
DigitalWrite(19) = temBool(3)
DigitalWrite(20) = temBool(4)

GetBit (receArray(6))
DigitalWrite(21) = temBool(1)
DigitalWrite(22) = temBool(2)
DigitalWrite(23) = temBool(3)
DigitalWrite(24) = temBool(4)

GetBit (receArray(7))
DigitalWrite(25) = temBool(2)

'发送数字量到WinCC
MyGroup_DigitalWrite.SyncWrite 25, ServerHandle, DigitalWrite, Errors

'模拟量的解析
AnalogWrite(1) = receArray(11) * 256 + receArray(12)
AnalogWrite(2) = receArray(13) * 256 + receArray(14)
AnalogWrite(3) = receArray(15) * 256 + receArray(16)
'发送模拟量到WinCC
MyGroup_AnalogWrite.SyncWrite 3, ServerHandle, AnalogWrite, Errors

End If

'处理发送
'从WinCC读数字量
MyGroup_DigitalRead.SyncRead OPCCache, 18, ServerHandle, DigitalValue, Errors

For i = 1 To 18
If DigitalValue(i) Then
    DigitalRead(i) = 1
Else
    DigitalRead(i) = 0
End If

Next i

'整合数字量字节，共6字节
For i = 1 To 16 Step 3
sendArray((i + 2) \ 3) = DigitalRead(i) * 16 + DigitalRead(i + 1) * 32 + DigitalRead(i + 2) * 64
Next i

'从WinCC读模拟量
MyGroup_AnalogRead.SyncRead OPCCache, 7, ServerHandle, AnalogValue, Errors
For i = 1 To 7
AnalogRead(i) = AnalogValue(i)
Next i


'整合模拟量字节，共12个
j% = 1
For i = 7 To 19 Step 2
sendArray(i) = AnalogRead(j) \ 256
sendArray(i + 1) = AnalogRead(j) Mod 256
j = j + 1
Next i

'加最后校验字节
sendArray(21) = 254

'发送
MSComm.Output = sendArray

End Sub
Private Sub GetBit(ByteData As Byte)
Dim byte0, byte2 As Byte
Dim bool As Boolean

byte0 = ByteData
For i = 1 To 8
bool = byte0 Mod 2
byte2 = byte0 \ 2

temBool(i) = bool
byte0 = byte2
Next i
End Sub