• 목록
  • 아래로
  • 위로
  • 0
  • 콜라다
  • 조회 수 4546
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

공유

facebooktwitterpinterestbandkakao story
퍼머링크

댓글 0

권한이 없습니다.