- 0
- 콜라다
- 조회 수 4716
Melsec MC Protocol Ethernet 통신을 할때 사용하는 명령어를 모듈로 간단하게 만들어 보았습니다.
예전 글인데 저장해 뒀던 내용이라
필요하신분이 있을 것같아 올려 놓습니다.
------------------모듈 & 함수------------------------------
Option Explicit
Private Const HexStr As String = "0123456789ABCDEF"
Private Const ASCII_Header As String = "500000FF03E000"
Private Const Read_ASCII_Command As String = "001004010000D*"
Private Const Write_ASCII_Command As String = "000114010000D*"
Private Const Binary_Header As String = "500000FFE00300"
Private Const Binary_Read_Command As String = "100001040000"
Private Const Binary_Write_Command As String = "100001140000"
Public Function Get_ASCII_Read(ByVal byAdd As String, ByVal byLen As Integer) As String
Dim Read_Cnt As String
Dim LenData As String
Read_Cnt = Get_FillString(hex(byLen), "L", "0", 4)
LenData = Get_FillString(hex(Len(Read_ASCII_Command & Get_FillString(byAdd, "L", "0", 6) & Read_Cnt)), "L", "0", 4)
Get_ASCII_Read = ASCII_Header & LenData & Read_ASCII_Command & Get_FillString(byAdd, "L", "0", 6) & Read_Cnt
End Function
Public Function Get_ASCII_Write(ByVal byAdd As String, ByVal byData As String) As String
Dim Read_Cnt As String
Dim LenData As String
Read_Cnt = Get_FillString(hex(Get_ASCII_Length(byData)), "L", "0", 4)
LenData = Get_FillString(hex(Len(Write_ASCII_Command & Get_FillString(byAdd, "L", "0", 6) & Read_Cnt & byData)), "L", "0", 4)
Get_ASCII_Write = ASCII_Header & LenData & Write_ASCII_Command & Get_FillString(byAdd, "L", "0", 6) & Read_Cnt & byData
End Function
Public Function Get_Binary_Read(ByVal byAdd As String, ByVal byLen As Integer) As String
Dim strTmp As String
Dim Read_Cnt As String
byAdd = Get_Reserve_Data(Get_FillString(Dec2Hex(byAdd), "L", "0", 6))
Read_Cnt = Get_Reserve_Data(Get_FillString(Dec2Hex(byLen), "L", "0", 4))
strTmp = Get_Reserve_Data(Get_FillString(Dec2Hex(Get_Binary_Length(Binary_Read_Command & byAdd & "A8" & Read_Cnt)), "L", "0", 4))
strTmp = Binary_Header & strTmp & Binary_Read_Command & byAdd & "A8" & Read_Cnt
Get_Binary_Read = strTmp
End Function
Public Function Ger_Binary_Write(ByVal byAdd As String, ByVal byData As Integer) As String
Dim strTmp As String
Dim strData As String
byAdd = Get_Reserve_Data(Get_FillString(Dec2Hex(byAdd), "L", "0", 6))
strData = Get_Reserve_Data(Get_FillString(hex(Get_Binary_Length(Dec2Hex(byData))), "L", "0", 4))
strTmp = Get_Reserve_Data(Get_FillString(Dec2Hex(Get_Binary_Length(Binary_Read_Command & byAdd & "A8" & byData)), "L", "0", 4))
strTmp = Binary_Header & strTmp & Binary_Write_Command & byAdd & "A8" & strData & Dec2Hex(byData) 'Get_Reserve_Data(Get_FillString(Dec2Hex(byData), "L", "0", 4))
Ger_Binary_Write = strTmp
End Function
Public Function Get_Reserve_Data(ByVal byData As String) As String
Dim strTmp As String
Dim i As Integer
For i = Len(byData) To 1 Step -2
strTmp = strTmp & Mid$(byData, i - 1, 2)
Next
Get_Reserve_Data = strTmp
End Function
Public Function Get_ASCII_Length(ByVal wData As String) As Integer
Dim i As Integer
Dim cnt As Integer
For i = 1 To Len(wData) Step 4
cnt = cnt + 1
Next
Get_ASCII_Length = cnt
End Function
Public Function Get_Binary_Length(ByVal wData As String) As Integer
Dim i As Integer
Dim cnt As Integer
For i = 1 To Len(wData) Step 2
cnt = cnt + 1
Next
Get_Binary_Length = cnt
End Function
Public Function Get_FillString(ByVal nData As String, ByVal LR As String, ByVal FillStr As String, ByVal dLen As Integer) As String
Dim i As Integer
Dim strTmp As String
For i = 1 To dLen - Len(nData)
strTmp = strTmp & FillStr
Next i
If UCase(LR) = "L" Then
Get_FillString = strTmp & nData
Else
Get_FillString = nData & strTmp
End If
End Function
Public Function Hex2Dec(ByVal hex As String) As String
Dim i As Integer
Dim result As Long
hex = Replace(hex, " ", ""): hex = UCase(hex)
If Len(hex) = 0 Or Len(hex) > 7 Then: Hex2Dec = "": Exit Function
For i = 1 To Len(hex)
result = result + CLng((InStr(HexStr, Right(hex, 1)) - 1) * 16 ^ (i - 1))
hex = Left(hex, Len(hex) - 1)
Next i
Hex2Dec = result
End Function
Public Function Dec2Hex(ByVal Dec As String) As String
Dim d As Long, m As Long
Dim result As String
Dec = Replace(Dec, " ", "")
If Len(Dec) = 0 Or Len(Dec) > 9 Then: Dec2Hex = "": Exit Function
Do
d = CLng(Dec) \ 16
m = CLng(Dec) Mod 16
result = Mid(HexStr, m + 1, 1) & result
Dec = d
Loop Until d < 16
If d > 0 Then result = Mid(HexStr, d + 1, 1) & result
Dec2Hex = IIf(Len(result) < 2, "0" & result, result)
End Function
Public Function HexToChar(hex As String) As String
If Len(hex) <> 4 Then
HexToChar = Chr("&H" & hex)
Else
HexToChar = Chr("&H" & Mid(hex, 3, 2)) & Chr("&H" & Mid(hex, 1, 2))
End If
End Function
Public Function Chr2Hex(Rcv As String) As String
Dim i As Integer
For i = 1 To Len(Rcv)
Chr2Hex = Chr2Hex & hex(Asc(Mid(Rcv, i, 1)))
Next
End Function
-----------------------함수콜할때는---------------------------
1) Ascii 모드로 읽을때..
ReadMode ="A"
If sckPLC.State = 7 Then sckPLC.SendData Get_ASCII_Read(시작어드레스,읽을길이)
2) Binary 모드로 읽을때..
Private Sub cmdBRead_Click()
Dim tmpByte() As Byte
Dim strTmp As String
Dim i As Integer
Dim j As Integer
ReadMode = "B"
strTmp = Get_Binary_Read(txtAddress.Text, txtData.Text)
ReDim tmpByte((Len(strTmp) \ 2) - 1)
j = 1
For i = 0 To UBound(tmpByte)
tmpByte(i) = Hex2Dec(Mid$(strTmp, j, 2))
j = j + 2
Next
If sckPLC.State = 7 Then sckPLC.SendData tmpByte
End Sub
3) PLC응답부분(결과)
Private Sub sckPLC_DataArrival(ByVal bytesTotal As Long)
Dim Ls_RevData As String
Dim ByteAry() As Byte
Dim i As Long
On Error Resume Next
ReDim Preserve ByteAry(bytesTotal - 1)
txtResult = Empty
If ReadMode = "A" Then
sckPLC.GetData Ls_RevData, vbString, bytesTotal
Else
sckPLC.GetData ByteAry, vbArray + vbByte, bytesTotal
For i = 0 To UBound(ByteAry)
Ls_RevData = Ls_RevData & Dec2Hex(ByteAry(i)) 'StrConv(ByteAry(i), vbUnicode) ' Ls_RevData
Next
End If
txtResult = Hex2Dec(Get_Reserve_Data(Mid$(Ls_RevData, 23)))
End Sub
강간사님 포함 1명이 추천
추천인 1
공유
댓글 0
권한이 없습니다.
