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通訊計(jì)算校驗(yàn)碼
''' </summary>
''' <param name="Value">傳入需要校驗(yàn)內(nèi)容</param>
''' <returns>返回Fins校驗(yàn)值</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
''' 寫(xiě)單個(gè)PLC值函數(shù)
'''
''' </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進(jìn)制長(zhǎng)度
Dim HexAddNum As String '地址值轉(zhuǎn)到16進(jìn)制
Dim HCode As String = "@00FA000000000" '通訊表頭
Dim CommandCode As String = "0102" '通訊命令代碼
Dim MemoryAreaCode As String 'PLC內(nèi)存功能碼
Dim BitNum As String = "00" '位寫(xiě)入需要寫(xiě)數(shù)值 0-15；字寫(xiě)如=0
Dim WriteNum As String = "0001" '寫(xiě)PLC地址個(gè)數(shù)；單個(gè)寫(xiě)入=0001
Dim HexValue As String '寫(xiě)入數(shù)值轉(zhuǎn)換為16進(jìn)制
Dim FCSString As String '需要校驗(yàn)的字符串
Dim FCSValue As String '命令校驗(yàn)碼
Dim EndCode As String = "*" & vbCr '結(jié)束碼
Dim SenCode As String '發(fā)送到PLC字符串
'*************************************************************************
'修改版本20150526 新建
'寫(xiě)入數(shù)值到D
'通訊發(fā)送命令
'HCode & CommandCode & MemoryAreaCode & HEXADDNum & BitNum & WriteNum & Value & FCS & EndCode
'*************************************************************************
Try
If PLCBusyBit = False And OmronPLC.IsOpen Then
PLCCommd = 1
PLCBusyBit = True
'選擇寫(xiě)入PLC地址類(lèi)型
Select Case AddName
Case "D"
MemoryAreaCode = "82"
Case Else
Return 1000
Exit Function
End Select
'寫(xiě)入地址轉(zhuǎn)換為HEX，計(jì)算長(zhǎng)度是否=4；長(zhǎng)度不夠補(bǔ)滿
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
'寫(xiě)入數(shù)值轉(zhuǎn)換位16進(jìn)制，計(jì)算長(zhǎng)度=4；長(zhǎng)度不夠布滿
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 返回結(jié)果處理
Dim StartTick As Integer
StartTick = Environment.TickCount
Do
If (Environment.TickCount - StartTick) > 1500 Then
'超時(shí)報(bào)警
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
'未知錯(cuò)誤報(bào)警
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進(jìn)制長(zhǎng)度
Dim HexAddNum As String '地址值轉(zhuǎn)到16進(jìn)制
Dim HCode As String = "@00FA000000000" '通訊表頭
Dim CommandCode As String = "0101" '通訊命令代碼
Dim MemoryAreaCode As String 'PLC內(nèi)存功能碼
Dim BitNum As String = "00" '位讀取需要寫(xiě)數(shù)值 0-15；字讀入=0
Dim ReadNum As String = "0001" '讀PLC地址個(gè)數(shù)；單個(gè)寫(xiě)入=0001
'Dim HexValue As String '寫(xiě)入數(shù)值轉(zhuǎn)換為16進(jìn)制
Dim FCSString As String '需要校驗(yàn)的字符串
Dim FCSValue As String '命令校驗(yàn)碼
Dim EndCode As String = "*" & vbCr '結(jié)束碼
Dim SenCode As String '發(fā)送到PLC字符串
'*************************************************************************
'修改版本2015703 新建
'讀D數(shù)值
'通訊發(fā)送命令
'HCode & CommandCode & MemoryAreaCode & HEXADDNum & BitNum & ReadNum & FCS & EndCode
'*************************************************************************
Try
If PLCBusyBit = False And OmronPLC.IsOpen Then
PLCCommd = 1
PLCBusyBit = True
'選擇讀PLC地址類(lèi)型
Select Case AddName
Case "D"
MemoryAreaCode = "82"
Case Else
Return 1000
Exit Function
End Select
'讀地址轉(zhuǎn)換為HEX，計(jì)算長(zhǎng)度是否=4；長(zhǎng)度不夠補(bǔ)滿
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 返回結(jié)果處理
Dim StartTick As Integer
StartTick = Environment.TickCount
Do
If (Environment.TickCount - StartTick) > 1500 Then
'超時(shí)報(bào)警
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
'未知錯(cuò)誤報(bào)警
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 '返回校驗(yàn)碼
Dim FcsCount As String = String.Empty '計(jì)算出校驗(yàn)碼
Dim RtCommand As String = String.Empty '返回命令
Dim RtMsg As String = String.Empty '返回報(bào)警代碼
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寫(xiě)入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寫(xiě)入PLC值正常
RtErrValue(0) = "1"
Exit Sub
End If
Case Else
'不能識(shí)別通訊命令
RtErrValue(0) = "9002"
Exit Sub
End Select
Else
'返回校驗(yàn)碼不對(duì)報(bào)警
RtErrValue(0) = "9001"
End If
Else
'返回字符串長(zhǎng)度不夠報(bào)警
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
滬公網(wǎng)安備31010802001143號(hào)
