sampleform.frm

vb通讯程序 vb 与三菱PLc的通讯程序源码

        '(It is the example as follows.)
        ActACPU1.ActCpuType = CPU_A1NCPU    'CPU_A1NCPU is set in the CPU type.
        ActACPU1.ActPortNumber = PORT_1     'PORT_1 is set in the COM port.
                                            'Other properties use the default value
        lRet = ActACPU1.Open                'The Open method is executed.
    End Select
    'The execution result of the method is displayed by the hexadecimal.
    Txt_ReturnCode.Text = Hex$(lRet) + "(Hex)"
Exit Sub

Error:  'Exception processing
    ErrMsg = Error$(Err)
    MsgBox ErrMsg, vbCritical
    End
End Sub

'/****************************************************************************/
'/*  <SUB>   Cmd_Close_Click                                                 */
'/*  [[[Processing of Close button]]]                                        */
'/****************************************************************************/
Private Sub Cmd_Close_Click()
    Dim lRet As Long    'Return value

    On Error GoTo Error 'Error Handler

    'Displayed output data is cleared
    Call ClsOutputData

    'Processing according to use control
    Select Case ControlIndex
    Case CONTROL_ACTEASYIF
        'When you use control of ActEasyIF
        lRet = ActEasyIF1.Close         'The Close method is executed.
    Case CONTROL_ACTACPU
        'When you use control of ActACPU
        lRet = ActACPU1.Close           'The Close method is executed.
    End Select
    'The execution result of the method is displayed by the hexadecimal.
    Txt_ReturnCode.Text = Hex$(lRet) + "(Hex)"
Exit Sub

Error:  'Exception processing
    ErrMsg = Error$(Err)
    MsgBox ErrMsg, vbCritical
    End
End Sub

'/****************************************************************************/
'/*  <SUB>   Cmd_GetCpuType_Click                                            */
'/*  [[[Processing of "GetCpuType" button]]]                                 */
'/****************************************************************************/
Private Sub Cmd_GetCpuType_Click()
    Dim lRet As Long            'Return value
    Dim szCpuName As String     'PLC type character string
    Dim lplCpuCode As Long      'PLC type code

    On Error GoTo Error 'Error Handler.

    'Displayed output data is cleared.
    Call ClsOutputData

    'Processing according to use control.
    Select Case ControlIndex
    Case CONTROL_ACTEASYIF
        'When you use control of ActEasyIF
        lRet = ActEasyIF1.GetCpuType(szCpuName, lplCpuCode)   'The GetCpuType method is executed.
    Case CONTROL_ACTACPU
        'When you use control of ActACPU
        lRet = ActACPU1.GetCpuType(szCpuName, lplCpuCode)     'The GetCpuType method is executed.
    End Select
    'The execution result of the method is displayed by the hexadecimal.
    Txt_ReturnCode.Text = Hex$(lRet) + "(Hex)"
    If lRet = 0 Then
        Lst_Data.AddItem (szCpuName)                        'PLC type character string.
        Lst_Data.AddItem (Hex$(lplCpuCode) & "(Hex)")       'PLC type code(hexadecimal display).
    End If
Exit Sub

Error:  'Exception processing
    ErrMsg = Error$(Err)
    MsgBox ErrMsg, vbCritical
    End
End Sub

'/****************************************************************************/
'/*  <SUB>   Cmd_ReadDeviceRandom_Click                                      */
'/*  [[[Processing of ReadDeviceRandom button]]]                             */
'/****************************************************************************/
Private Sub Cmd_ReadDeviceRandom_Click()
    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

    On Error GoTo Error 'Error Handler

    'Displayed output data is cleared.
    Call ClsOutputData

    szDeviceList = ChgDeviceString(Txt_DeviceName.Text)  'The Txt_DeviceName is converted into szDeviceList.
    lSize = CLng(Txt_DeviceSize.Text)                    'The Txt_DeviceSize is set in lSize.
    ReDim lData(lSize)                                   'The memory of the DeviceData is allocated.

    'Processing according to use control
    Select Case ControlIndex
    Case CONTROL_ACTEASYIF
        'When you use control of ActEasyIF
        lRet = ActEasyIF1.ReadDeviceRandom(szDeviceList, lSize, lData(0))   'The ReadDeviceRandom method is executed.
    Case CONTROL_ACTACPU
        'When you use control of ActACPU
        lRet = ActACPU1.ReadDeviceRandom(szDeviceList, lSize, lData(0))     'The ReadDeviceRandom method is executed.
    End Select
    'The execution result of the method is displayed by the hexadecimal
    Txt_ReturnCode.Text = Hex$(lRet) + "(Hex)"
    If lRet = 0 Then
        For lCnt = 0 To (lSize - 1)
            Lst_Data.AddItem (lData(lCnt) & "[" & Hex$(lData(lCnt)) & "(Hex)]")   'DeviceData display (decimal/hexadecimal display)
        Next
    End If
Exit Sub

Error:  'Exception processing
    ErrMsg = Error$(Err)
    MsgBox ErrMsg, vbCritical
    End
End Sub

'/****************************************************************************/
'/*  <SUB>   Cmd_WriteDeviceRandom_Click                                     */
'/*  [[[Processing of "WriteDeviceRandom" button]]]                          */
'/****************************************************************************/
Private Sub Cmd_WriteDeviceRandom_Click()
    Dim lRet As Long            'Return value
    Dim szDeviceList As String  'DeviceList
    Dim lSize As Long           'WriteSize
    Dim lData() As Long         'DeviceData

    On Error GoTo Error 'Error Handler

    'Displayed output data is cleared
    Call ClsOutputData

    szDeviceList = ChgDeviceString(Txt_DeviceName.Text)     'The Txt_DeviceName is converted into szDeviceList.
    lSize = CLng(Txt_DeviceSize.Text)                       'The Txt_DeviceSize is set in lSize.
    ReDim lData(lSize)                                      'The memory of the lData is allocated.
    Call ChgDeviceData(lSize, Txt_DeviceData.Text, lData)   'The Txt_DeviceData is converted into lData.

    'Processing according to use control.
    Select Case ControlIndex
    Case CONTROL_ACTEASYIF
        'When you use control of ActEasyIF
        lRet = ActEasyIF1.WriteDeviceRandom(szDeviceList, lSize, lData(0))  'The WriteDeviceRandom method is executed.
    Case CONTROL_ACTACPU
        'When you use control of ActACPU
        lRet = ActACPU1.WriteDeviceRandom(szDeviceList, lSize, lData(0))    'The WriteDeviceRandom method is executed.
    End Select
    'The execution result of the method is displayed by the hexadecimal
    Txt_ReturnCode.Text = Hex$(lRet) + "(Hex)"
Exit Sub

Error:  'Exception processing
    ErrMsg = Error$(Err)
    MsgBox ErrMsg, vbCritical
    End
End Sub

'/****************************************************************************/
'/*  <SUB>   Opt_Control_Click                                               */
'/*  [[[Processing according to use control]]]                               */
'/****************************************************************************/
Private Sub Opt_Control_Click(Index As Integer)
    'Processing according to use control
    Select Case Index
    Case CONTROL_ACTEASYIF
        'When you use control of ActEasyIF
        ControlIndex = CONTROL_ACTEASYIF
        Lbl_LogicalStationNumber.Visible = True
        Txt_LogicalStationNumber.Visible = True
    Case CONTROL_ACTACPU
        'When you use control of ActACPU
        ControlIndex = CONTROL_ACTACPU
        Lbl_LogicalStationNumber.Visible = False
        Txt_LogicalStationNumber.Visible = False
    End Select
End Sub

'/****************************************************************************/
'/*  <SUB>   ClsOutputData                                                   */
'/*  [[[Displayed output data is cleared]]]                                  */
'/****************************************************************************/
Function ClsOutputData()
    Txt_ReturnCode.Text = ""    'Clear ReturnCode
    Lst_Data.Clear              'Clear Data
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