Public Class OmronFins
Dim WithEvents OmronPLC As New System.IO.Ports.SerialPort
Dim WithEvents T1 As New Timer
Dim MLog As New MyFB.RunErrLog
''' <summary>
''' PLC返回字符
''' </summary>
''' <remarks></remarks>
Dim PLCRtString As String
''' <summary>
''' =True 等待RS返回信息
''' </summary>
''' <remarks></remarks>
Dim PLCBusyBit As Boolean = False
Dim PLCCommd As Integer = 0
Dim RtValue(19) As String
Dim RtErrValue(19) As String
Sub RS232PortSet(ByVal PortNum As Integer)
Try
With OmronPLC
.BaudRate = 38400
.StopBits = 2
.DataBits = 7
.Parity = IO.Ports.Parity.Even
.PortName = "COM" & PortNum
.ReceivedBytesThreshold = 1
End With
If OmronPLC.IsOpen = False Then
OmronPLC.Open()
End If
Catch ex As Exception
MLog.LogErrWrite(ex.ToString)
End Try
End Sub
Sub RS232PortClose()
If OmronPLC.IsOpen = True Then
OmronPLC.Close()
End If
End Sub
Sub RS232SendMsg(ByVal SendString As String)
Dim LenNum As Integer
LenNum = SendString.Length
If OmronPLC.IsOpen = True Then
OmronPLC.Write(SendString)
Else
PLCBusyBit = False
End If
End Sub
''' <summary>
''' 20150525
''' Fins通讯计算校验码
''' </summary>
''' <param name="Value">传入需要校验内容</param>
''' <returns>返回Fins校验值</returns>
''' <remarks></remarks>
Public Function FinsFcsCheck(ByVal Value As String) As String
Dim CheckValue As Integer
Dim CheckHex As String
For i As Integer = 1 To Value.Length
CheckValue = Asc(Mid(Value, i, 1)) Xor CheckValue
Next
CheckHex = Hex(CheckValue)
If CheckHex.Length < 2 Then
CheckHex = "0" & CheckHex
End If
Return CheckHex
End Function
''' <summary>
''' 20150526
''' 写单个PLC值函数
'''
''' </summary>
''' <param name="AddName"></param>
''' <param name="Value"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function SetValue(ByVal AddName As String, ByVal AddNum As Integer, ByVal Value As Integer) As Integer
Dim AddNumHexLen As Integer '地址16进制长度
Dim HexAddNum As String '地址值转到16进制
Dim HCode As String = "@00FA000000000" '通讯表头
Dim CommandCode As String = "0102" '通讯命令代码
Dim MemoryAreaCode As String 'PLC内存功能码
Dim BitNum As String = "00" '位写入需要写数值 0-15；字写如=0
Dim WriteNum As String = "0001" '写PLC地址个数；单个写入=0001
Dim HexValue As String '写入数值转换为16进制
Dim FCSString As String '需要校验的字符串
Dim FCSValue As String '命令校验码
Dim EndCode As String = "*" & vbCr '结束码
Dim SenCode As String '发送到PLC字符串
'*************************************************************************
'修改版本20150526 新建
'写入数值到D
'通讯发送命令
'HCode & CommandCode & MemoryAreaCode & HEXADDNum & BitNum & WriteNum & Value & FCS & EndCode
'*************************************************************************
Try
If PLCBusyBit = False And OmronPLC.IsOpen Then
PLCCommd = 1
PLCBusyBit = True
'选择写入PLC地址类型
Select Case AddName
Case "D"
MemoryAreaCode = "82"
Case Else
Return 1000
Exit Function
End Select
'写入地址转换为HEX，计算长度是否=4；长度不够补满
HexAddNum = Hex(AddNum)
AddNumHexLen = HexAddNum.Length
Select Case AddNumHexLen
Case 1
HexAddNum = "000" & HexAddNum
Case 2
HexAddNum = "00" & HexAddNum
Case 3
HexAddNum = "0" & HexAddNum
Case 4
HexAddNum = HexAddNum
Case Else
Return 1001
Exit Function
End Select
'写入数值转换位16进制，计算长度=4；长度不够布满
HexValue = Hex(Value)
Select Case HexValue.Length
Case 1
HexValue = "000" & HexValue
Case 2
HexValue = "00" & HexValue
Case 3
HexValue = "0" & HexValue
Case 4
HexValue = HexValue
Case Else
Return 1002
Exit Function
End Select
FCSString = HCode & CommandCode & MemoryAreaCode & HexAddNum & BitNum & WriteNum & HexValue
FCSValue = FinsFcsCheck(FCSString)
SenCode = FCSString & FCSValue & EndCode
RS232SendMsg(SenCode)
' Threading.Thread.Sleep(10)
'***************************************************
'20150608 返回结果处理
Dim StartTick As Integer
StartTick = Environment.TickCount
Do
If (Environment.TickCount - StartTick) > 1500 Then
'超时报警
PLCBusyBit = False
Return 9001
Exit Do
End If
If PLCBusyBit = False Then
Exit Do
End If
Application.DoEvents()
Loop
If RtErrValue(0) = "1" Then
Return 1
Else
'未知错误报警
Return 9002
End If
Else
'通讯BUSY
Return 9003
End If
Catch ex As Exception
' MsgBox(ex.Message)
MLog.LogErrWrite(ex.ToString)
End Try
End Function
Public Function GetValue(ByVal AddName As String, ByVal AddNum As Integer, ByRef RtV As Integer) As Integer
Dim AddNumHexLen As Integer '地址16进制长度
Dim HexAddNum As String '地址值转到16进制
Dim HCode As String = "@00FA000000000" '通讯表头
Dim CommandCode As String = "0101" '通讯命令代码
Dim MemoryAreaCode As String 'PLC内存功能码
Dim BitNum As String = "00" '位读取需要写数值 0-15；字读入=0
Dim ReadNum As String = "0001" '读PLC地址个数；单个写入=0001
'Dim HexValue As String '写入数值转换为16进制
Dim FCSString As String '需要校验的字符串
Dim FCSValue As String '命令校验码
Dim EndCode As String = "*" & vbCr '结束码
Dim SenCode As String '发送到PLC字符串
'*************************************************************************
'修改版本2015703 新建
'读D数值
'通讯发送命令
'HCode & CommandCode & MemoryAreaCode & HEXADDNum & BitNum & ReadNum & FCS & EndCode
'*************************************************************************
Try
If PLCBusyBit = False And OmronPLC.IsOpen Then
PLCCommd = 1
PLCBusyBit = True
'选择读PLC地址类型
Select Case AddName
Case "D"
MemoryAreaCode = "82"
Case Else
Return 1000
Exit Function
End Select
'读地址转换为HEX，计算长度是否=4；长度不够补满
HexAddNum = Hex(AddNum)
AddNumHexLen = HexAddNum.Length
Select Case AddNumHexLen
Case 1
HexAddNum = "000" & HexAddNum
Case 2
HexAddNum = "00" & HexAddNum
Case 3
HexAddNum = "0" & HexAddNum
Case 4
HexAddNum = HexAddNum
Case Else
Return 1001
Exit Function
End Select
FCSString = HCode & CommandCode & MemoryAreaCode & HexAddNum & BitNum & ReadNum
FCSValue = FinsFcsCheck(FCSString)
SenCode = FCSString & FCSValue & EndCode
RS232SendMsg(SenCode)
' Threading.Thread.Sleep(10)
'***************************************************
'20150608 返回结果处理
Dim StartTick As Integer
StartTick = Environment.TickCount
Do
If (Environment.TickCount - StartTick) > 1500 Then
'超时报警
PLCBusyBit = False
Return 9001
Exit Do
End If
If PLCBusyBit = False Then
Exit Do
End If
Application.DoEvents()
Loop
If RtErrValue(0) = "1" Then
RtV = Convert.ToInt32(RtValue(0), 16)
Return 1
Else
'未知错误报警
Return 9002
End If
Else
'通讯BUSY
Return 9003
End If
Catch ex As Exception
' MsgBox(ex.Message)
MLog.LogErrWrite(ex.ToString)
End Try
End Function
Private Sub OmronPLC_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles OmronPLC.DataReceived
Threading.Thread.Sleep(100)
Dim ReadString As String
If OmronPLC.IsOpen = True Then
ReadString = OmronPLC.ReadExisting
Call ReslutCount(ReadString)
End If
PLCBusyBit = False
End Sub
Sub ReslutCount(ByVal InputS As String)
Dim FcsRead As String = String.Empty '返回校验码
Dim FcsCount As String = String.Empty '计算出校验码
Dim RtCommand As String = String.Empty '返回命令
Dim RtMsg As String = String.Empty '返回报警代码
Dim OKMsg As String = "0000" '返回正确代码
Try
If InputS.Length >= 25 Then
If Mid(Microsoft.VisualBasic.Right(InputS, 2), 1, 1) = "*" Then
PLCRtString = Mid(InputS, 1, InputS.Length - 4)
FcsRead = Mid(InputS, InputS.Length - 3, 2)
FcsCount = FinsFcsCheck(PLCRtString)
RtCommand = Microsoft.VisualBasic.Mid(PLCRtString, 16, 4)
End If
If FcsCount = FcsRead Then
Select Case RtCommand
Case "0101"
RtMsg = Microsoft.VisualBasic.Mid(PLCRtString, 20, 4)
If RtMsg = OKMsg Then
'=1写入PLC值正常
RtValue(0) = Microsoft.VisualBasic.Mid(PLCRtString, 24, 4)
RtErrValue(0) = "1"
Exit Sub
End If
Case "0102"
RtMsg = Microsoft.VisualBasic.Mid(PLCRtString, 20, 4)
If RtMsg = OKMsg Then
'=1写入PLC值正常
RtErrValue(0) = "1"
Exit Sub
End If
Case Else
'不能识别通讯命令
RtErrValue(0) = "9002"
Exit Sub
End Select
Else
'返回校验码不对报警
RtErrValue(0) = "9001"
End If
Else
'返回字符串长度不够报警
RtErrValue(0) = "9000"
End If
Catch ex As Exception
MLog.LogErrWrite(ex.ToString)
End Try
End Sub
Sub ResetErr()
Try
If OmronPLC.IsOpen = True Then
OmronPLC.Close()
End If
If OmronPLC.IsOpen = False Then
OmronPLC.Open()
End If
PLCBusyBit = False
Catch ex As Exception
MLog.LogErrWrite(ex.ToString)
MsgBox(ex.Message)
End Try
End Sub
End Class
沪公网安备31010802001143号
