[吐血奉献]VB与三菱Q系列PLC通信模块

‘函数作者：纪小年 http://8jxn.com
‘需要使用一个MSComm控件

‘Q系列通讯协议小结

‘指令由命令+子命令构成
‘BR,0401+0001
‘BW,1401+0001
‘WR,0401+0000
‘WW,1401+0000
‘PC,0101+0000

‘经由Q系列E71时,用ASCII代码进行通讯时3584点,用二进制代码进行通讯时7168点;经由Q系列C24时,7904点.
‘一次通讯能够处理3584个点（X、Y、M）或者960个字（X、Y、M）或者960个点（D、R、T、C）’
‘960字=15360点
‘————————————————————————–
‘————————————————————————–
‘发送数据
‘  SD = ENQ + “F9”       + “00” + “00”     + “FF”    + “00”      + “1401” + “0000” + “D*”       + “000379”   + “0004”     + Sdata + Chr$(&HD) + Chr$(&HA)
‘  控制代码 + 帧识别编号 + 站号 + 网络编号 + PLC编号 +上位站编号 + 命令   + 子命令 + 软元件代码 + 起开软元件 + 软元件点数 + 数据  + 结束码
‘————————————————————————–
‘接收数据
‘正常
‘  RD = STX + “F9”       + “00” + “00”     + “FF”    + “00”      + Rdata + ETX
‘  控制代码 + 帧识别编号 + 站号 + 网络编号 + PLC编号 +上位站编号 + 数据  + ETX
‘错误
‘  RD = NAK + “F9”       + “00” + “00”     + “FF”    + “00”      + Rdata
‘  控制代码 + 帧识别编号 + 站号 + 网络编号 + PLC编号 +上位站编号 + 出错代码
‘————————————————————————–
‘————————————————————————–

‘特殊
‘x SBW,1402+0001  随即位写入
‘x SWW,1402+0000  随即字写入
‘SWR,0403+0000  随即字读出
‘————————————————————————–
‘————————————————————————–
‘发送数据
‘  SD = ENQ + “F9”       + “00” + “00”     + “FF”    + “00”      + “0403” + “0000” + “01”  + “00”    + “D*”        + “000379”  + …… + Chr$(&HD) + Chr$(&HA)
‘  控制代码 + 帧识别编号  + 站号 + 网络编号  + PLC编号 +上位站编号  + 命令   + 子命令 + 字点数 + 双字点数 + 软元件代码  + 软元件    + …… + 结束码
‘————————————————————————–

‘————————————————————————–

‘————————————————————————–

‘————————————————————————–

Public Type My_TRANS_DATA
MY_TRAN_ADRS As String ‘地址
MY_TRAN_NUMB As Integer ‘单双字标志,1为单字，0为双字
MY_TRAN_DATA As String ‘数据
End Type
Public My_Trans() As My_TRANS_DATA

Public WordReadKey As String
Public BitReadKey As String
Public WordReadKey1 As Single
Public WordReadKey2 As Single

‘以下为PLC通讯控制代码.是控制协议的一部分
Public Const STX = “”
Public Const ENQ = “”
Public Const ACK = “”
Public Const ETX = “”
Public Const NAK = “”
‘Public Const CR As String = Chr$(&HD)
‘Public Const LF = Chr$(&HA)

Declare Function timeGetTime Lib “winmm.dll” () As Long

Public Sub Delay_ms(ByVal My_Time As Integer)
Dim SaveTime As Double
SaveTime = timeGetTime
While Not My_Unload And timeGetTime < SaveTime + My_Time
DoEvents
Wend
End Sub

‘******************************************************************
‘函数名  ： PC_Test
‘输入值  ： MyRsCom，MyRsComPort
‘输入说明： MyRsCom     MSComm  是传送的控件
‘           MyRsComPort Integer 是传送数据的串口号
‘返回值  ： PC_Test
‘返回说明： 返回1，地址错误
‘           返回2，传入数量超范围
‘           返回3，传入数据错误
‘           返回4，传送次数过多
‘******************************************************************
Public Function PC_Test(MyRsCom As MSComm, MyRsComPort As Integer) As String
On Error GoTo ll
If MyRsCom.PortOpen = True Then MyRsCom.PortOpen = False
MyRsCom.CommPort = MyRsComPort
MyRsCom.Settings = “19200,O,8,1”
MyRsCom.PortOpen = True

Again: SD = ENQ + “F90000FF00” + “01010000” + Chr$(&HD) + Chr$(&HA)
MyRsCom.Output = SD
Delay_ms (100)
If My_Unload Then Exit Function
RD = MyRsCom.Input
‘debug.Print RD
i = i + 1
If Left(RD, 1) = NAK Then PC_Test = “PLC Error”: Exit Function
If Left(RD, 11) <> STX + “F90000FF00” And i < 10 Then GoTo Again
MyRsCom.PortOpen = False

If i = 10 Then
PC_Test = “PLC Not Found”
Else
PC_Test = Trim(Mid(RD, 12, 16))
End If
Exit Function
ll:
MsgBox ERR.Description + “…请更换端口重试”, vbOKOnly + vbCritical, “啊哦，连接失败了！”
End Function

‘******************************************************************
‘函数名  ： PC_WordWrite
‘实现功能： 顺序写入字
‘输入值  ： MyRsCom，MyRsComPort，Adress，Number，Word
‘输入说明： MyRsCom     MSComm  是传送的控件
‘           MyRsComPort Integer 是传送数据的串口号
‘           Adress      String  就是要写入的起始地址，8个字符，示例：M*000640，D*000001。可写入XYMTCDR
‘           Nuber       Integer 字写入指令以字为单位，所以Nuber值就是字的个数。
‘           Word        String  就是要写入的内容，每个字4个字符，以十六进制表示，示例：2347。
‘返回值  ： PC_WordWrite
‘返回说明： 返回1，地址错误
‘           返回2，传入数量超范围
‘           返回3，传入数据错误
‘           返回4，传送次数过多
‘******************************************************************
Public Function PC_WordWrite(MyRsCom As MSComm, MyRsComPort As Integer, Adress As String, Number As Integer, ByVal Word As String) As Integer
On Error GoTo ll
If Len(Adress) <> 8 Or (Mid(Adress, 1, 2) <> “X*” And Mid(Adress, 1, 2) <> “Y*” _
And Mid(Adress, 1, 2) <> “M*” _
And Mid(Adress, 1, 2) <> “D*” And Mid(Adress, 1, 2) <> “R*” _
And Mid(Adress, 1, 2) <> “T*” And Mid(Adress, 1, 2) <> “C*”) Then
PC_WordWrite = 1
Exit Function
End If

If Number < 1 Or Number > 960 Then
PC_WordWrite = 2
Exit Function
End If

If Len(Word) <> Number * 4 Then
PC_WordWrite = 3
Exit Function
End If

Dim MyNum As String
MyNum = CStr(Hex(Number))
For i = 1 To 4 – Len(MyNum)
MyNum = “0” & MyNum
Next i

If MyRsCom.PortOpen = True Then MyRsCom.PortOpen = False
MyRsCom.CommPort = MyRsComPort
MyRsCom.Settings = “19200,O,8,1”
MyRsCom.PortOpen = True

i = 1
Again: SD = ENQ + “F90000FF00” + “14010000” + Adress + MyNum + Word + Chr$(&HD) + Chr$(&HA)
MyRsCom.Output = SD
j = 1
RD = “”
Again1: Delay_ms (100)
If My_Unload Then Exit Function
RD = RD + MyRsCom.Input
j = j + 1
‘debug.Print RD
If Len(RD) <> 13 And j < 10 Then GoTo Again1
i = i + 1
If RD <> ACK + “F90000FF00” + Chr$(&HD) + Chr$(&HA) And i < 5 Then GoTo Again
MyRsCom.PortOpen = False

If i = 5 Then
PC_WordWrite = 4
Exit Function
End If

PC_WordWrite = 0
ll:
End Function

‘******************************************************************
‘函数名  ： PC_WordRead
‘实现功能： 顺序读出字
‘输入值  ： MyRsCom，MyRsComPort，Adress，Number
‘输入说明： MyRsCom     MSComm  是传送的控件
‘           MyRsComPort Integer 是传送数据的串口号
‘           Adress      String  就是要写入的起始地址，8个字符，示例：M*000640，D*000001。可写入XYMTCDR
‘           Nuber       Integer 字读出指令以字为单位，所以Nuber值就是字的个数。
‘返回说明： 返回1，地址错误
‘           返回2，传入数量超范围
‘           返回3，传送次数过多
‘******************************************************************
Public Function PC_WordRead(MyRsCom As MSComm, MyRsComPort As Integer, Adress As String, Number As Integer) As Integer
On Error GoTo ll
WordReadKey = “”
WordReadKey1 = Empty
WordReadKey2 = Empty
If Len(Adress) <> 8 Or (Mid(Adress, 1, 2) <> “X*” And Mid(Adress, 1, 2) <> “Y*” _
And Mid(Adress, 1, 2) <> “M*” _
And Mid(Adress, 1, 2) <> “D*” And Mid(Adress, 1, 2) <> “R*” _
And Mid(Adress, 1, 2) <> “T*” And Mid(Adress, 1, 2) <> “C*”) Then
PC_WordRead = 1
Exit Function
End If

If Number < 1 Or Number > 960 Then
PC_WordRead = 2
Exit Function
End If

Dim MyNum As String
MyNum = CStr(Hex(Number))
For i = 1 To 4 – Len(MyNum)
MyNum = “0” & MyNum
Next i

If MyRsCom.PortOpen = True Then MyRsCom.PortOpen = False
MyRsCom.CommPort = MyRsComPort
MyRsCom.Settings = “19200,O,8,1”
MyRsCom.PortOpen = True

‘  SD = ENQ + “F9”       + “00” + “00”     + “FF”    + “00”      + “1401” + “0000” + “D*”       + “000379”   + “0004”     + Sdata + Chr$(&HD) + Chr$(&HA)
‘  RD = STX + “F9”       + “00” + “00”     + “FF”    + “00”      + Rdata + ETX

i = 1
Again: SD = ENQ + “F90000FF00” + “04010000” + Adress + MyNum + Chr$(&HD) + Chr$(&HA)
MyRsCom.Output = SD
j = 1
RD = “”
Again1: Delay_ms (200)
If My_Unload Then Exit Function
RD = RD + MyRsCom.Input
j = j + 1
If Len(RD) <> Number * 4 + 14 And j < 10 Then GoTo Again1
i = i + 1
If Left(RD, 11) <> STX + “F90000FF00” And i < 5 Then GoTo Again
MyRsCom.PortOpen = False

If i = 5 Then
PC_WordRead = 3
Exit Function
End If

WordReadKey = Mid(RD, 12, Number * 4)
PC_WordRead = 0

If Number = 1 Then
WordReadKey1 = CDec(“&H” + WordReadKey)
Else: WordReadKey1 = 0
End If
If Number = 2 Then
WordReadKey2 = CDec(“&H” + Mid(WordReadKey, 5, 4) + Mid(WordReadKey, 1, 4))
Else: WordReadKey2 = 0
End If
Exit Function
ll:
End Function

‘******************************************************************
‘函数名  ： PC_BitWrite
‘输入值  ： MyRsCom，MyRsComPort，Adress，Number，Word
‘输入说明： MyRsCom     MSComm  是传送的控件
‘           MyRsComPort Integer 是传送数据的串口号
‘           Adress      String  就是要写入的起始地址，8个字符，示例：M*000640，X*000001。可写入XYM
‘           Nuber       Integer 位写入指令以位为单位，所以Nuber值就是位的个数。
‘           Word        String  就是要写入的内容，每个位1个字符，以二进制表示，示例：0,1。
‘返回值  ： PC_BitWrite
‘返回说明： 返回1，地址错误
‘           返回2，传入数量超范围
‘           返回3，传入数据错误
‘           返回4，传送次数过多
‘******************************************************************
Public Function PC_BitWrite(MyRsCom As MSComm, MyRsComPort As Integer, Adress As String, Number As Integer, Word As String) As Integer
On Error GoTo ll
If Len(Adress) <> 8 Or (Mid(Adress, 1, 2) <> “X*” And Mid(Adress, 1, 2) <> “Y*” _
And Mid(Adress, 1, 2) <> “M*”) Then
PC_BitWrite = 1
Exit Function
End If

If Number < 1 Or Number > 3584 Then
PC_BitWrite = 2
Exit Function
End If

If Len(Word) <> Number Then
PC_BitWrite = 3
Exit Function
End If

Dim MyNum As String
MyNum = CStr(Hex(Number))
For i = 1 To 4 – Len(MyNum)
MyNum = “0” & MyNum
Next i

If MyRsCom.PortOpen = True Then MyRsCom.PortOpen = False
MyRsCom.CommPort = MyRsComPort
MyRsCom.Settings = “19200,O,8,1”
MyRsCom.PortOpen = True

‘  SD = ENQ + “F9”       + “00” + “00”     + “FF”    + “00”      + “1401” + “0000” + “D*”       + “000379”   + “0004”     + Sdata + Chr$(&HD) + Chr$(&HA)
‘  RD = STX + “F9”       + “00” + “00”     + “FF”    + “00”      + Rdata + ETX

i = 1
Again: SD = ENQ + “F90000FF00” + “14010001” + Adress + MyNum + Word + Chr$(&HD) + Chr$(&HA)
MyRsCom.Output = SD
j = 1
RD = “”
Again1: Delay_ms (200)
If My_Unload Then Exit Function
RD = RD + MyRsCom.Input
‘debug.Print RD
j = j + 1
If Len(RD) <> 13 And j < 10 Then GoTo Again1
i = i + 1
If RD <> ACK + “F90000FF00” + Chr$(&HD) + Chr$(&HA) And i < 5 Then GoTo Again
MyRsCom.PortOpen = False

If i = 5 Then
PC_BitWrite = 4
Exit Function
End If

PC_BitWrite = 0
ll:
End Function

‘******************************************************************
‘函数名  ： PC_BitRead
‘输入值  ： MyRsCom，MyRsComPort，Adress，Number
‘输入说明： MyRsCom     MSComm  是传送的控件
‘           MyRsComPort Integer 是传送数据的串口号
‘           Adress      String  就是要写入的起始地址，8个字符，示例：M*000640，X*000001。可写入XYM
‘           Nuber       Integer 位写入指令以位为单位，所以Nuber值就是位的个数。
‘返回值  ： PC_BitRead
‘返回说明： 返回1，地址错误
‘           返回2，传入数量超范围
‘           返回3，传送次数过多
‘******************************************************************
Public Function PC_BitRead(MyRsCom As MSComm, MyRsComPort As Integer, Adress As String, Number As Integer) As Integer
On Error GoTo ll
BitReadKey = “”
If Len(Adress) <> 8 Or (Mid(Adress, 1, 2) <> “X*” And Mid(Adress, 1, 2) <> “Y*” _
And Mid(Adress, 1, 2) <> “M*”) Then
PC_BitRead = 1
Exit Function
End If

If Number < 1 Or Number > 3584 Then
PC_BitRead = 2
Exit Function
End If

Dim MyNum As String
MyNum = CStr(Hex(Number))
For i = 1 To 4 – Len(MyNum)
MyNum = “0” & MyNum
Next i

If MyRsCom.PortOpen = True Then MyRsCom.PortOpen = False
MyRsCom.CommPort = MyRsComPort
MyRsCom.Settings = “19200,O,8,1”
MyRsCom.PortOpen = True

i = 1
Again: SD = ENQ + “F90000FF00” + “04010001” + Adress + MyNum + Chr$(&HD) + Chr$(&HA)
MyRsCom.Output = SD
j = 1
RD = “”
Again1: Delay_ms (200)
If My_Unload Then Exit Function
RD = RD + MyRsCom.Input
j = j + 1
If Len(RD) <> Number + 14 And j < 10 Then GoTo Again1
i = i + 1
If Left(RD, 11) <> STX + “F90000FF00” And i < 5 Then GoTo Again
MyRsCom.PortOpen = False

If i = 5 Then
PC_BitRead = 3
Exit Function
End If

BitReadKey = Mid(RD, 12, Number)
PC_BitRead = 0
ll:
End Function

‘******************************************************************
‘函数名  ： PC_RandomWordRead
‘实现功能： 随机读出字
‘输入值  ： MyRsCom，MyRsComPort，Adress，Number
‘输入说明： MyRsCom     MSComm  是传送的控件
‘           MyRsComPort Integer 是传送数据的串口号
‘           Adress      String  就是要写入的起始地址，8个字符，示例：M*000640，D*000001。可写入XYMTCDR
‘           Nuber       Integer 字读出指令以字为单位，所以Nuber值就是字的个数。
‘返回说明： 返回1，地址错误
‘           返回2，传入数量超范围
‘           返回3，传送次数过多
‘******************************************************************
Public Function PC_RandomWordRead(MyRsCom As MSComm, MyRsComPort As Integer, DX() As My_TRANS_DATA) As Integer
Dim My_ONE As Integer
Dim My_MUT As Integer
Dim My_ONE_DATA As String
Dim My_MUT_DATA As String
For i = 0 To UBound(DX)
If Len(DX(i).MY_TRAN_ADRS) <> 8 Or (Mid(DX(i).MY_TRAN_ADRS, 1, 2) <> “X*” And Mid(DX(i).MY_TRAN_ADRS, 1, 2) <> “Y*” _
And Mid(DX(i).MY_TRAN_ADRS, 1, 2) <> “M*” _
And Mid(DX(i).MY_TRAN_ADRS, 1, 2) <> “D*” And Mid(DX(i).MY_TRAN_ADRS, 1, 2) <> “R*” _
And Mid(DX(i).MY_TRAN_ADRS, 1, 2) <> “T*” And Mid(DX(i).MY_TRAN_ADRS, 1, 2) <> “C*”) Then
PC_RandomWordRead = 1
Exit Function
End If

If DX(i).MY_TRAN_NUMB = 1 Then
My_ONE = My_ONE + 1
My_ONE_DATA = My_ONE_DATA + DX(i).MY_TRAN_ADRS
ElseIf DX(i).MY_TRAN_NUMB = 0 Then
My_MUT = My_MUT + 1
My_MUT_DATA = My_MUT_DATA + DX(i).MY_TRAN_ADRS
End If
Next i
If My_ONE + My_MUT * 2 > 192 Then PC_RandomWordRead = 2: Exit Function

Dim My_ONE_S As String
My_ONE_S = CStr(Hex(My_ONE))
For i = 1 To 2 – Len(My_ONE_S)
My_ONE_S = “0” & My_ONE_S
Next i
Dim My_MUT_S As String
My_MUT_S = CStr(Hex(My_MUT))
For i = 1 To 2 – Len(My_MUT_S)
My_MUT_S = “0” & My_MUT_S
Next i

If MyRsCom.PortOpen = True Then MyRsCom.PortOpen = False
MyRsCom.CommPort = MyRsComPort
MyRsCom.Settings = “19200,O,8,1”
MyRsCom.PortOpen = True

i = 1
Again: SD = ENQ + “F90000FF00” + “04030000” + My_ONE_S + My_MUT_S + My_ONE_DATA + My_MUT_DATA + Chr$(&HD) + Chr$(&HA)
MyRsCom.Output = SD
j = 1
RD = “”
Again1: Delay_ms (200)
If My_Unload Then Exit Function
RD = RD + MyRsCom.Input
j = j + 1
If Len(RD) <> (My_ONE + My_MUT * 2) * 4 + 14 And j < 10 Then GoTo Again1
i = i + 1
If Left(RD, 11) <> STX + “F90000FF00” And i < 5 Then GoTo Again
MyRsCom.PortOpen = False

If i = 5 Then
PC_RandomWordRead = 3
Exit Function
End If

Dim NUMM, NUMN As Integer
Dim RDDD As String
NUMM = 1: NUMN = My_ONE * 4 + 1
RDDD = Mid(RD, 12, (My_ONE + My_MUT * 2) * 4)

For i = 0 To UBound(DX)
If DX(i).MY_TRAN_NUMB = 1 Then
DX(i).MY_TRAN_DATA = Mid(RDDD, NUMM, 4)
NUMM = NUMM + 4
ElseIf DX(i).MY_TRAN_NUMB = 0 Then
DX(i).MY_TRAN_DATA = Mid(RDDD, NUMN, 8)
NUMN = NUMN + 8
End If
Next i
End Function

‘补满8位 并高低位互换
‘
Public Function ChangeDWord(NeedCH As String) As String
Dim TNDC As String
TNDC = NeedCH
For j = 1 To 8 – Len(TNDC)
TNDC = “0” + TNDC
Next j
ChangeDWord = Mid(TNDC, 5) + Mid(TNDC, 1, 4)
End Function

‘补满4位
‘
Public Function ChangeWord(NeedCH As String) As String
Dim TNDC As String
TNDC = NeedCH
For j = 1 To 4 – Len(TNDC)
TNDC = “0” + TNDC
Next j
ChangeWord = TNDC
End Function

‘十六进制转二进制
‘
Public Function HexToBin(cWord As String) As String
Dim bitd As String
For i = 1 To Len(cWord)
If Mid(cWord, i, 1) = “0” Then bitd = bitd + “0000”
If Mid(cWord, i, 1) = “1” Then bitd = bitd + “0001”
If Mid(cWord, i, 1) = “2” Then bitd = bitd + “0010”
If Mid(cWord, i, 1) = “3” Then bitd = bitd + “0011”
If Mid(cWord, i, 1) = “4” Then bitd = bitd + “0100”
If Mid(cWord, i, 1) = “5” Then bitd = bitd + “0101”
If Mid(cWord, i, 1) = “6” Then bitd = bitd + “0110”
If Mid(cWord, i, 1) = “7” Then bitd = bitd + “0111”
If Mid(cWord, i, 1) = “8” Then bitd = bitd + “1000”
If Mid(cWord, i, 1) = “9” Then bitd = bitd + “1001”
If Mid(cWord, i, 1) = “A” Then bitd = bitd + “1010”
If Mid(cWord, i, 1) = “B” Then bitd = bitd + “1011”
If Mid(cWord, i, 1) = “C” Then bitd = bitd + “1100”
If Mid(cWord, i, 1) = “D” Then bitd = bitd + “1101”
If Mid(cWord, i, 1) = “E” Then bitd = bitd + “1110”
If Mid(cWord, i, 1) = “F” Then bitd = bitd + “1111”
Next i
HexToBin = bitd
End Function