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號
