VB刚做的MODBUS与仪表通讯,OPC与WINCC通讯,已经成功,发上来与大家分享,希望斑竹不要删帖,(*^__^*) 嘻嘻…… QQ:413599191
Option Explicit
'=================== OPC==========================
Option Base 1
Dim WithEvents MyOPCServer As OPCServer
Dim WithEvents MyOPCGroup As OPCGroup
Private ClientHandles() As Long
Private ServerHandles() As Long
Private Errors() As Long
Private SName As String '服务器名称
Private ItemIDs() As String
Private SNode As String '计算机名或者网址
Private Item_num As Long
Dim valuess() As Variant

Dim sc As Integer
Dim date1 As Variant
Dim Tcommand(0 To 7) As Byte
Dim address As Integer '地址
Dim CRC16Lo As Byte 'CRC16Lo为CRC寄存器低8位
Dim CRC16Hi As Byte 'CRC16Hi为CRC寄存器高8位
Dim value(0 To 500) As Byte
Dim dd(0 To 500) As Single
Dim num As Integer
Dim start_add_H As Byte '起始地址 高
Dim start_add_L As Byte '起始地址 低
Dim data_num_H As Byte '数据长度 高
Dim data_num_l As Byte '数据长度 低
Dim pd_data(0 To 500) As Single
Private Sub Form_Load() '窗体启动

Timer1.Enabled = False
Timer2.Enabled = True

sc = 1

If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
With MSComm1
.CommPort = 1
.InBufferSize = 1024 '开辟数据缓冲区
.Settings = "9600,n,8,1"
.InputMode = comInputModeBinary '设定为二进制的数据流方式
End With
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
End Sub

Private Sub Timer2_Timer()

Dim I As Integer
Dim j As Integer
'===============变量个数==================
Item_num = 72
'=========================================

'==============定义WINCC变量名称===================
ReDim ItemIDs(Item_num)

'建立WINCC内部变量名称 (d1_1,d1_2......d1_35),(d2_1,d2_2......d2_35)

For I = 1 To 2
For j = 0 To 35
ItemIDs((I - 1) * 36 + j + 1) = "d" & I & "_" & j '
Next
Next

SNode = ""
Call Connect("OPCServer.WinCC", SNode)
Call Add_Group("Internal tags")
Call Add_Items(ItemIDs(), Item_num)

Timer2.Enabled = False
Timer1.Enabled = True
End Sub

' ====================采用MODBUS-RTU协议====================
' ================仪表起始地址0100H,数据长度36个============

Private Sub Timer1_Timer() '向EX8仪表写报文
Dim I, K, j As Integer
Dim SSS
ReDim valuess(Item_num) As Variant
Timer1.Enabled = False
On Error GoTo ErrorHandler1
Select Case sc

Case 1
address = Val("&h" + "01") '读一号地址参数
Case 2
address = Val("&h" + "02") '读二号地址参数
End Select
start_add_H = Val("&h" + "01") '起始地址 高
start_add_L = Val("&h" + "00") '起始地址 低
data_num_H = Val("&h" + "00") '数据长度 高
data_num_l = Val("&h" + "24") '数据长度 低
Tcommand(0) = address '地址
Tcommand(1) = Val("&h" + "03") 'MODBUS 功能码
Tcommand(2) = start_add_H
Tcommand(3) = start_add_L
Tcommand(4) = data_num_H
Tcommand(5) = data_num_l

For I = 0 To 5
value(I) = Tcommand(I)
Next I

num = 6
Call CRC16 '调用CRC16校验子程序

Tcommand(6) = CRC16Lo 'CRC16低字节
Tcommand(7) = CRC16Hi 'CRC16高字节

MSComm1.Output = Tcommand '发送数据到EX8仪表

num = 2 * (data_num_H * 256 + data_num_l) + 5 '接收的数据个数

K = 0
Do
SSS = DoEvents() '等待接收
K = K + 1
If K > 30000 Then
For I = 0 To 76
value(I) = 0
Next

GoTo 888
End If
Loop Until (MSComm1.InBufferCount > num - 1)



date1 = MSComm1.Input

For I = 0 To num - 1
value(I) = date1(I)
Next

If value(0) <> address Then GoTo 999 '地址等否
If value(1) <> 3 Then GoTo 999 '功能码等否
num = num - 2
Call CRC16
If value(num + 1) <> CRC16Hi Then GoTo 999 'CRC 等否
If value(num) <> CRC16Lo Then GoTo 999 'CRC 等否

888
'====================数据处理====================

dd((address - 1) * 36 + 1) = F_FLOAT(value(3), value(4))

dd((address - 1) * 36 + 2) = U_FLOAT(value(5), value(6))
dd((address - 1) * 36 + 3) = U_FLOAT(value(7), value(8))
dd((address - 1) * 36 + 4) = U_FLOAT(value(9), value(10))
dd((address - 1) * 36 + 5) = U_FLOAT(value(11), value(12))

dd((address - 1) * 36 + 6) = U_FLOAT(value(13), value(14))
dd((address - 1) * 36 + 7) = U_FLOAT(value(15), value(16))
dd((address - 1) * 36 + 8) = U_FLOAT(value(17), value(18))
dd((address - 1) * 36 + 9) = U_FLOAT(value(19), value(20))

dd((address - 1) * 36 + 10) = I_FLOAT(value(21), value(22))
dd((address - 1) * 36 + 11) = I_FLOAT(value(23), value(24))
dd((address - 1) * 36 + 12) = I_FLOAT(value(25), value(26))
dd((address - 1) * 36 + 13) = I_FLOAT(value(27), value(28))
dd((address - 1) * 36 + 14) = I_FLOAT(value(29), value(30))

dd((address - 1) * 36 + 15) = PQS_FLOAT(value(31), value(32))
dd((address - 1) * 36 + 16) = PQS_FLOAT(value(33), value(34))
dd((address - 1) * 36 + 17) = PQS_FLOAT(value(35), value(36))
dd((address - 1) * 36 + 18) = DMD_FLOAT(value(37), value(38))

dd((address - 1) * 36 + 19) = PQS_FLOAT(value(39), value(40))
dd((address - 1) * 36 + 20) = PQS_FLOAT(value(41), value(42))
dd((address - 1) * 36 + 21) = PQS_FLOAT(value(43), value(44))
dd((address - 1) * 36 + 22) = DMD_FLOAT(value(45), value(46))

dd((address - 1) * 36 + 23) = PQS_FLOAT(value(47), value(48))
dd((address - 1) * 36 + 24) = PQS_FLOAT(value(49), value(50))
dd((address - 1) * 36 + 25) = PQS_FLOAT(value(51), value(52))
dd((address - 1) * 36 + 26) = DMD_FLOAT(value(53), value(54))

dd((address - 1) * 36 + 27) = PF_FLOAT(value(55), value(56))
dd((address - 1) * 36 + 28) = PF_FLOAT(value(57), value(58))
dd((address - 1) * 36 + 29) = PF_FLOAT(value(59), value(60))
dd((address - 1) * 36 + 30) = PF_FLOAT(value(61), value(62))

dd((address - 1) * 36 + 31) = UNBL_FLOAT(value(63), value(64))
dd((address - 1) * 36 + 32) = UNBL_FLOAT(value(65), value(66))
dd((address - 1) * 36 + 33) = (value(67) * 256 + value(68))

dd((address - 1) * 36 + 34) = DMD_FLOAT(value(69), value(70))
dd((address - 1) * 36 + 35) = DMD_FLOAT(value(71), value(72))
dd((address - 1) * 36 + 36) = DMD_FLOAT(value(73), value(74))

'显示数值到窗体
Text1.Text = Str(dd((address - 1) * 36 + 1))
Text2.Text = Str(dd((address - 1) * 36 + 2))
Text3.Text = Str(dd((address - 1) * 36 + 3))
Text4.Text = Str(dd((address - 1) * 36 + 4))
Text5.Text = Str(dd((address - 1) * 36 + 5))
Text6.Text = Str(dd((address - 1) * 36 + 6))
Text7.Text = Str(dd((address - 1) * 36 + 7))
Text8.Text = Str(dd((address - 1) * 36 + 8))
Text9.Text = Str(dd((address - 1) * 36 + 9))
Text10.Text = Str(dd((address - 1) * 36 + 10))
Text11.Text = Str(dd((address - 1) * 36 + 11))
Text12.Text = Str(dd((address - 1) * 36 + 12))
Text13.Text = Str(dd((address - 1) * 36 + 13))
Text14.Text = Str(dd((address - 1) * 36 + 14))
Text15.Text = Str(dd((address - 1) * 36 + 15))
Text16.Text = Str(dd((address - 1) * 36 + 16))
Text17.Text = Str(dd((address - 1) * 36 + 17))
Text18.Text = Str(dd((address - 1) * 36 + 18))
Text19.Text = Str(dd((address - 1) * 36 + 19))
Text20.Text = Str(dd((address - 1) * 36 + 20))
Text21.Text = Str(dd((address - 1) * 36 + 21))
Text22.Text = Str(dd((address - 1) * 36 + 22))
Text23.Text = Str(dd((address - 1) * 36 + 23))
Text24.Text = Str(dd((address - 1) * 36 + 24))
Text25.Text = Str(dd((address - 1) * 36 + 25))
Text26.Text = Str(dd((address - 1) * 36 + 26))
Text27.Text = Str(dd((address - 1) * 36 + 27))
Text28.Text = Str(dd((address - 1) * 36 + 28))
Text29.Text = Str(dd((address - 1) * 36 + 29))
Text30.Text = Str(dd((address - 1) * 36 + 30))
Text31.Text = Str(dd((address - 1) * 36 + 31))
Text32.Text = Str(dd((address - 1) * 36 + 32))
Text33.Text = Str(dd((address - 1) * 36 + 33))
Text34.Text = Str(dd((address - 1) * 36 + 34))
Text35.Text = Str(dd((address - 1) * 36 + 35))
Text36.Text = Str(dd((address - 1) * 36 + 36))

Text37.Text = sc

999

If sc = 2 Then

For I = 1 To Item_num
valuess(I) = Str(dd(I))
Next
MyOPCGroup.SyncWrite Item_num, ServerHandles, valuess, Errors '同步写
End If

ErrorHandler1:
sc = sc + 1
If sc > 2 Then sc = 1
Timer1.Enabled = True

End Sub
Private Sub Form_Unload(Cancel As Integer) '断开OPC连接
On Error GoTo ErrorHandler3
Call Rem_Items(Item_num)
Call Rem_Group("Internal tags")
Call Disconnect
ErrorHandler3:
End Sub
Sub Connect(ServerName, NodeName) '连接子函数

On Error GoTo ErrorHandler

Set MyOPCServer = New OPCServer
MyOPCServer.Connect ServerName, NodeName
Exit Sub

ErrorHandler:
End Sub
Sub Add_Group(Groupname) '添加组函数

On Error GoTo ErrorHandler

MyOPCServer.OPCGroups.DefaultGroupUpdateRate = 0
Set MyOPCGroup = MyOPCServer.OPCGroups.Add(Groupname)
MyOPCGroup.IsSubscribed = True
MyOPCGroup.IsActive = True
Exit Sub
ErrorHandler:
End Sub
Sub Add_Items(ItemIDs() As String, Item_num As Long) '添加标签集合

Dim I As Long
ReDim ClientHandles(Item_num)

On Error GoTo ErrorHandler
For I = 1 To Item_num
ClientHandles(I) = I
Next

MyOPCGroup.IsSubscribed = False

MyOPCGroup.OPCItems.AddItems Item_num, ItemIDs, ClientHandles, ServerHandles, Errors

MyOPCGroup.IsSubscribed = True '允许订阅或者异步读取方式
Erase Errors()

' MsgBox "Add Item successful!" 'vbCritical

Exit Sub

ErrorHandler:
'MsgBox "Add Item Error!", vbCritical

End Sub
Sub Disconnect()

'MyOPCServer.Disconnect
Set MyOPCServer = Nothing

End Sub


Sub Rem_Group(Groupname As String) '删除组对象

'MyOPCServer.OPCGroups.Remove Groupname
Set MyOPCGroup = Nothing

End Sub
Sub Rem_Items(Item_num As Long) '删除标签集合对象
On Error GoTo ErrorHandler2
'MyOPCGroup.OPCItems.Remove Item_num, ServerHandles, Errors
Erase ClientHandles()
Erase ServerHandles()
Erase Errors()
ErrorHandler2:
End Sub
Public Sub CRC16() 'CRC16效验

Dim CL, CH, UseHi, UseLo As Byte
Dim I, Index As Integer

CRC16Lo = &HFF 'CRC16Lo为CRC寄存器低8位
CRC16Hi = &HFF 'CRC16Hi为CRC寄存器高8位
CL = &H1
CH = &HA0 'A001 H 是CRC－16多项式代码
For I = 0 To num - 1
CRC16Lo = CRC16Lo Xor value(I) '每一个数据与CRC寄存器异或
For Index = 0 To 7
UseHi = CRC16Hi
UseLo = CRC16Lo
CRC16Hi = CRC16Hi \ 2
CRC16Lo = CRC16Lo \ 2 '右移一位
If ((UseHi And &H1) = &H1) Then '如果高位字节最后一位是1的话
CRC16Lo = CRC16Lo Or &H80 '低位字节右移后前面补1
End If

If ((UseLo And &H1) = &H1) Then '如果LSB 为1，则与多项式进行异或
CRC16Hi = CRC16Hi Xor CH
CRC16Lo = CRC16Lo Xor CL
End If
Next Index
Next I
End Sub
Function F_FLOAT(A_H As Byte, A_L As Byte) '频率

Dim E_H As Single
Dim E_L As Single

E_H = A_H
E_L = A_L

F_FLOAT = (E_H * 256 + E_L) / 100

End Function
Function PF_FLOAT(A_H As Byte, A_L As Byte) '功率因数值PFA、PFB、PFC、PFS

Dim E_H As Single
Dim E_L As Single

E_H = A_H
E_L = A_L

PF_FLOAT = (E_H * 256 + E_L) / 10000

End Function
Function U_FLOAT(A_H As Byte, A_L As Byte) '电压值UA、UB、UC

Dim E_H As Single
Dim E_L As Single
Dim E_DPT As Single

E_H = A_H
E_L = A_L


U_FLOAT = ((E_H * 256 + E_L) / 10000) * 250

End Function
Function I_FLOAT(A_H As Byte, A_L As Byte) '电流值IA、IB、IC

Dim E_H As Single
Dim E_L As Single

E_H = A_H
E_L = A_L


I_FLOAT = ((E_H * 256 + E_L) / 10000) * 5

End Function
Function PQS_FLOAT(A_H As Byte, A_L As Byte) '

Dim E_H As Single
Dim E_L As Single

E_H = A_H
E_L = A_L

PQS_FLOAT = (E_H * 256 + E_L) / 10000 * 250 * 5

End Function
Function DMD_FLOAT(A_H As Byte, A_L As Byte) '

Dim E_H As Single
Dim E_L As Single

E_H = A_H
E_L = A_L

DMD_FLOAT = (E_H * 256 + E_L) / 10000 * 250 * 5 * 3

End Function
Function UNBL_FLOAT(A_H As Byte, A_L As Byte) '

Dim E_H As Single
Dim E_L As Single

E_H = A_H
E_L = A_L

UNBL_FLOAT = (E_H * 256 + E_L) / 10000

End Function