(VB6) MX 컴포넌트용 함수 모음

VB6에서 MX 통신을 할 때 사용하는 함수를 모아보았다.

 

한 번에 하나의 디바이스만 읽을 수 있도록 코드를 수정하였다

 

'The declaration of constants Const MAX_SIZE_OF_ARRAY = 20 'Size of array for reading/writing 'Word' data to the PLC(D0-D9) Const ELEMENT_SIZE_WORD = 10 'Size of elements, when reading/writing 'Word' data to the PLC. Const ELEMENT_SIZE_32BITINTEGER = 2 'Size of elements, when reading/writing '32bit Integer' data to the PLC. Const ELEMENT_SIZE_REALNUMBER = 2 'Size of elements, when reading/writing 'Real Number' data to the PLC. 'Declare user-defined types(To copy the other type value by LSet function.) 'Data for reading/writing to the PLC Private Type udtInteger iarrInteger(MAX_SIZE_OF_ARRAY - 1) As Integer End Type 'Data for 'Word' Private Type udtWord szarrWord As String * MAX_SIZE_OF_ARRAY End Type 'Data for '32bit Integer' Private Type udt32BitInteger l32BitInteger As Long End Type 'Data for 'Real Number' Private Type udtRealNumber sgRealNumber As Single End Type 'Temporary data for 'Word' Private Type udtByte byByteData(MAX_SIZE_OF_ARRAY - 1) As Byte End Type 'Other Dim szErrMsg As String 'Data for error message '/****************************************************************************/ '/* <SUB> Cmd_ReadDeviceRandom_Click */ '/* [[[Processing of ReadDeviceRandom button]]] */ '/****************************************************************************/ Public Function ReadDeviceRandom(Address As String) Dim lRet As Long 'Return value Dim szDeviceList As String 'DeviceList Dim lSize As Long 'ReadSize Dim lData() As Long 'DeviceData Dim lCnt As Long 'Loop counter Dim Value As String On Error GoTo Error 'Error Handler 'szDeviceList = ChgDeviceString(Txt_DeviceName.Text) 'The Txt_DeviceName is converted into szDeviceList. 'lSize = CLng(Txt_DeviceSize.Text) 'The Txt_DeviceSize is set in lSize. szDeviceList = ChgDeviceString(Address & vbCrLf) lSize = 1 ReDim lData(lSize) ' PLC로부터 읽어 들인다. lRet = Form1.PLC.ReadDeviceRandom(szDeviceList, lSize, lData(0)) ReadDeviceRandom = lData(0) Exit Function Error: 'Exception processing ErrMsg = Error$(Err) MsgBox ErrMsg, vbCritical End End Function '/****************************************************************************/ '/* <SUB> WriteDeviceRandom */ '/* [[[Processing of "WriteDeviceRandom" button]]] */ '/****************************************************************************/ Public Function WriteDeviceRandom(Address As String, Data As String) Dim lRet As Long 'Return value Dim szDeviceList As String 'DeviceList Dim Txt_DeviceData As String 'DeviceList Dim lSize As Long 'WriteSize Dim lData() As Long 'DeviceData On Error GoTo Error 'Error Handler 'szDeviceList = ChgDeviceString(Txt_DeviceName.Text) 'The Txt_DeviceName is converted into szDeviceList. 'lSize = CLng(Txt_DeviceSize.Text) 'The Txt_DeviceSize is set in lSize. ' CR을 없앤다. szDeviceList = ChgDeviceString(Address & vbCr) lSize = 1 Txt_DeviceData = Data & vbCr ReDim lData(lSize) Call ChgDeviceData(lSize, Txt_DeviceData, lData) lRet = Form1.PLC.WriteDeviceRandom(szDeviceList, lSize, lData(0)) WriteDeviceRandom = lRet Exit Function Error: ErrMsg = Error$(Err) MsgBox ErrMsg, vbCritical End End Function '/****************************************************************************/ '/* <SUB> btn_ReadWord_Click */ '/* [[[Processing of Read button for Word]]] */ '/****************************************************************************/ Public Function ReadWord(Address As String, Size As Integer) Dim lReturnCode As Long 'Return code Dim bufferWord As udtWord 'User-defined type for 'Word' data Dim bufferInteger As udtInteger 'User-defined type for reading to the PLC 'Error Handler On Error GoTo CatchError 'The WriteDeviceBlock2 method is executed.(from D0-D9) lReturnCode = Form1.PLC.ReadDeviceBlock2(Address, _ Size, _ bufferInteger.iarrInteger(0)) 'When ActEasyIF returns error code, display error message. If lReturnCode <> 0 Then DisplayErrorMessage (lReturnCode) Exit Function End If 'Copy the 'bufferInteger' to the user-defined type for 'Word' data. LSet bufferWord = bufferInteger 'Convert to Unicode, and set the data to the TextBox. ReadWord = StrConv(bufferWord.szarrWord, vbUnicode) Exit Function CatchError: 'Exception processing szErrMsg = Error$(Err) MsgBox szErrMsg, vbCritical End End Function '/****************************************************************************/ '/* <SUB> btn_WriteWord_Click */ '/* [[[Processing of Write button for Word]]] */ '/****************************************************************************/ Public Function WriteWord(Address As String, Data As String) Dim lReturnCode As Long 'Return code Dim bufferWord As udtWord 'User-defined type for 'Word' data Dim bufferInteger As udtInteger 'User-defined type for writing to the PLC Dim bufferByte As udtByte 'User-defined type for temporary data Dim szInputWord As String 'String of 'Word' Dim lSizeOfEncodedWord As Long 'Size of 'Word' Data encoded to ASCII Code Page Dim lNumber As Long 'Loop counter Dim str_len As Long 'Error Handler On Error GoTo CatchError szInputWord = Data str_len = Len(szInputWord) 'Get the size of 'Word' data encoded to ASCII Code Page. lSizeOfEncodedWord = LenB(StrConv(szInputWord, vbFromUnicode)) 'When the size of the encoded data is odd, 'the last charactor is not processed by StrConv function. 'therefore add 0 to the end of the data. If (lSizeOfEncodedWord Mod 2) = 1 Then szInputWord = szInputWord & Chr(0) End If 'Convert the 'szInputWord' to ASCII Code Page.(Maximum 20 bytes<for D0-D9>) bufferWord.szarrWord = Left(StrConv(szInputWord, vbFromUnicode), 20) 'Copy the 'bufferWord' to the user-defined type for editing 'Word' Data. LSet bufferByte = bufferWord 'Since the 'bufferByte' is copied from Fixed-size string, 'it has excess space charactors. 'therefore clear them by 0. For lNumber = lSizeOfEncodedWord To MAX_SIZE_OF_ARRAY - 1 bufferByte.byByteData(lNumber) = 0 Next lNumber 'Copy the 'bufferByte' to the user-defined type for writing to the PLC. LSet bufferInteger = bufferByte 'The WriteDeviceBlock2 method is executed.(to D0-D9) lReturnCode = Form1.PLC.WriteDeviceBlock2(Address, str_len, bufferInteger.iarrInteger(0)) 'When ActEasyIF returns error code, display error message. If lReturnCode <> 0 Then DisplayErrorMessage (lReturnCode) Exit Function End If Exit Function CatchError: 'Exception processing szErrMsg = Error$(Err) MsgBox szErrMsg, vbCritical End End Function '/****************************************************************************/ '/* <SUB> Read32BitInteger_Click */ '/* [[[[Processing of Read button for 32bit Integer]]] */ '/****************************************************************************/ Public Function Read32BitInteger(Address As String) Dim lReturnCode As Long 'Return code Dim buffer32BitInteger As udt32BitInteger 'User-defined type for '32bit Integer' Dim bufferInteger As udtInteger 'User-defined type for reading to the PLC 'Error Handler On Error GoTo CatchError 'The WriteDeviceBlock2 method is executed.(from D10-D11) lReturnCode = Form1.PLC.ReadDeviceBlock2(Address, _ ELEMENT_SIZE_32BITINTEGER, _ bufferInteger.iarrInteger(0)) 'When ActEasyIF returns error code, display error message. If lReturnCode <> 0 Then DisplayErrorMessage (lReturnCode) Exit Function End If 'Copy the 'bufferInteger' to the user-defined type for '32bit Integer' data. LSet buffer32BitInteger = bufferInteger 'Set the 32bit integer data to the TextBox as string. Read32BitInteger = CStr(buffer32BitInteger.l32BitInteger) Exit Function CatchError: 'Exception processing szErrMsg = Error$(Err) MsgBox szErrMsg, vbCritical End End Function '/****************************************************************************/ '/* <SUB> Write32BitInteger_Click */ '/* [[[Processing of Write button for 32bit Integer]]] */ '/****************************************************************************/ Public Function Write32BitInteger(Address As String, Data As String) Dim lReturnCode As Long 'Return code Dim buffer32BitInteger As udt32BitInteger 'User-defined type for '32bit Integer' data Dim bufferInteger As udtInteger 'User-defined type for writing to the PLC 'Error Handler On Error GoTo CatchError 'Copy the TextBox data to the user-defined type for '32bit Integer'. buffer32BitInteger.l32BitInteger = CLng(Data) 'Copy the 'buffer32BitInteger' to the user-defined type for writing to the PLC. LSet bufferInteger = buffer32BitInteger 'The WriteDeviceBlock2 method is executed.(to D10-D11) lReturnCode = Form1.PLC.WriteDeviceBlock2(Address, _ ELEMENT_SIZE_32BITINTEGER, _ bufferInteger.iarrInteger(0)) 'When ActEasyIF returns error code, display error message. If lReturnCode <> 0 Then DisplayErrorMessage (lReturnCode) Exit Function End If Write32BitInteger = lReturnCode Exit Function CatchError: 'Exception processing szErrMsg = Error$(Err) MsgBox szErrMsg, vbCritical End End Function '/****************************************************************************/ '/* <SUB> btn_ReadRealNumber_Click */ '/* [[[Processing of Read button for Real Number]]] */ '/****************************************************************************/ Public Function ReadRealNumber() Dim lReturnCode As Long 'Return code Dim bufferRealNumber As udtRealNumber 'User-defined type for 'Real Number' data Dim bufferInteger As udtInteger 'User-defined type for reading to the PLC 'Error Handler On Error GoTo CatchError 'The WriteDeviceBlock2 method is executed.(from D12-D13) lReturnCode = Form1.PLC.ReadDeviceBlock2("D12", _ ELEMENT_SIZE_REALNUMBER, _ bufferInteger.iarrInteger(0)) 'When ActEasyIF returns error code, display error message. If lReturnCode <> 0 Then DisplayErrorMessage (lReturnCode) Exit Function End If 'Copy the 'bufferInteger' to the user-defined type for 'Real Number' data. LSet bufferRealNumber = bufferInteger 'Set the real number data to the TextBox as string. ReadRealNumber = CStr(bufferRealNumber.sgRealNumber) Exit Function CatchError: 'Exception processing szErrMsg = Error$(Err) MsgBox szErrMsg, vbCritical End End Function '/****************************************************************************/ '/* <SUB> WriteRealNumber_Click */ '/* [[[[Processing of Write button for Real Number]]] */ '/****************************************************************************/ Private Function WriteRealNumber() Dim lReturnCode As Long 'Return code Dim bufferRealNumber As udtRealNumber 'User-defined type for 'Real Number' data Dim bufferInteger As udtInteger 'User-defined type for writing to the PLC 'Error Handler On Error GoTo CatchError 'Copy the TextBox data to the user-defined type for 'Real Number'. bufferRealNumber.sgRealNumber = CSng(txt_WriteRealNumber.Text) 'Copy the 'bufferRealNumber' to the user-defined type for writing to the PLC. LSet bufferInteger = bufferRealNumber 'The WriteDeviceBlock2 method is executed.(to D12-D13) lReturnCode = Form1.PLC.WriteDeviceBlock2("D12", _ ELEMENT_SIZE_REALNUMBER, _ bufferInteger.iarrInteger(0)) 'When ActEasyIF returns error code, display error message. If lReturnCode <> 0 Then DisplayErrorMessage (lReturnCode) Exit Function End If WriteRealNumber = lReturnCode Exit Function CatchError: 'Exception processing szErrMsg = Error$(Err) MsgBox szErrMsg, vbCritical End End Function Function DECtoSTR(DEC As Double) As String DECtoSTR = Chr(DEC Mod 128) & Chr(DEC) End Function '/****************************************************************************/ '/* <SUB> ChgDeviceString */ '/* [[[DeviceName conversion processing]]] */ '/* [[[ Conversion processing of DeviceName ]]] */ '/****************************************************************************/ Function ChgDeviceString(szDevice As String) As String Dim lCnt As Long 'Loop counter On Error GoTo Error 'Error Handler ChgDeviceString = "" 'Clear return value 'The data in the TextBox of DeviceName is converted into the argument of 'the ReadDeviceRandom/WriteDeviceRandom method. For lCnt = 1 To Len(szDevice) 'VBCR(Chr$(&HD)) is deleted. If (Mid$(szDevice, lCnt, 1) <> vbCr) Then ChgDeviceString = ChgDeviceString + Mid$(szDevice, lCnt, 1) End If Next Exit Function Error: 'Exception processing ErrMsg = Error$(Err) MsgBox ErrMsg, vbCritical End End Function '/****************************************************************************/ '/* <SUB> ChgDeviceData */ '/* [[[ Conversion processing of DeviceData ]]] */ '/****************************************************************************/ Function ChgDeviceData(lSize As Long, szData As String, lplData() As Long) Dim lCnt As Long 'Loop counter Dim lPos As Long 'Character string position Dim szBuf As String 'Work buffer On Error GoTo Error 'Error Handler szBuf = "" 'Clear Work buffer lCnt = 0 'Clear Loop counter 'DeviceData is converted into numeric array. For lPos = 1 To Len(szData) 'Whether all the conversion processings were done is judged. If (lCnt >= lSize) Then Exit For End If If (Mid$(szData, lPos, 2) = (vbCrLf)) Then If (IsNumeric(szBuf) = True) Then lplData(lCnt) = CLng(szBuf) Else 'The DeviceData is treated as 0 excluding the numerical value lplData(lCnt) = 0 End If lPos = lPos + 1 'The character string position is added by two characters. lCnt = lCnt + 1 'The loop counter is added by one count. szBuf = "" 'Work buffer is cleared. Else 'The data is set in the work buffer. szBuf = szBuf + Mid$(szData, lPos, 1) 'Whether the character string position is the final position is judged. If (lPos = Len(szData)) Then If (IsNumeric(szBuf) = True) Then lplData(lCnt) = CLng(szBuf) Else 'The DeviceData is treated as 0 excluding the numerical value. lplData(lCnt) = 0 End If End If End If Next Exit Function Error: 'Exception processing ErrMsg = Error$(Err) MsgBox ErrMsg, vbCritical End End Function '/****************************************************************************/ '/* <SUB> DisplayErrorMessage */ '/* [[[Processing of displaying error message]]] */ '/****************************************************************************/ Public Sub DisplayErrorMessage(ByVal lActReturnCode As Long) Dim szActErrorMessage As String 'Message as the return code of ActEasyIF Dim lSupportReturnCode As Long 'Return code of ActSupport 'The GetErrorMessage method is executed. lSupportReturnCode = ActSupport1.GetErrorMessage(lActReturnCode, szActErrorMessage) 'When ActSupport returns error code, display error code of ActEasyIF. If lSupportReturnCode <> 0 Then MsgBox ("Cannot get the string data of error message." & vbLf & _ " Error code = 0x" & Hex(lActReturnCode)) Else MsgBox szActErrorMessage, vbCritical End If End Sub

 

업데이트 중이므로 참고만 하세요.