cs7.cls

一个根据s7200协议写的驱动控件

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CS7"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Private Const SrcAddr As Integer = 0
Private Const DstAddr As Integer = 2
Private Const D_DB As Integer = &H2
Private Const D_DW As Integer = &H4
Private Const D_DD As Integer = &H6
Public Function read_Filed_Data(n_Type As String, n_Addr As Long, Optional n_Count As Integer = 1) As Variant          '读单个单位
Dim m_Reader As S7RorWProtocal
Dim tmp_Byte As Variant
Dim mData() As Byte
Dim i As Integer
Dim tmp_varAddr As Long
With m_Reader
    .SD = &H68
    .Length = &H1B
    .LengthRepeate = &H1B
    .DestinationAddr = 2
    .SourceAddress = 0
    .FunctionCode = &H7C
    .DstSrvAccPt = &H32
    .SrcSrvAccPt = &H1
     ReDim .DataUnit.DATA_UNIT_Command(9)
    .DataUnit.DATA_UNIT_Command(0) = 0    'READ_ID    n
    .DataUnit.DATA_UNIT_Command(1) = 0    'READ_ID    n
    .DataUnit.DATA_UNIT_Command(2) = &HA   'PDU_REF
    .DataUnit.DATA_UNIT_Command(3) = &HA    'PDU_REF
    .DataUnit.DATA_UNIT_Command(4) = 0    'PAR_LG
    .DataUnit.DATA_UNIT_Command(5) = &HE  'PAR_LG
    .DataUnit.DATA_UNIT_Command(6) = 0    'DAT_LG     n
    .DataUnit.DATA_UNIT_Command(7) = 0   'DAT_LG     n
    .DataUnit.DATA_UNIT_Command(8) = &H4  'SERVICE_ID n
    .DataUnit.DATA_UNIT_Command(9) = &H1  'number of variables
    .DataUnit.DATA_UNIT_Command_Address.Identifier = &H12  'variables spec n
    .DataUnit.DATA_UNIT_Command_Address.Command = &HA      'V_ADDR_LG n
    .DataUnit.DATA_UNIT_Command_Address.D_H10 = &H10       '
     Select Case LCase(n_Type)
        Case "vb"
            .DataUnit.DATA_UNIT_Command_Address.Data_Size = D_DB       '数据类型
        Case "vw"
             .DataUnit.DATA_UNIT_Command_Address.Data_Size = D_DW       '数据类型
        Case "vd"
            .DataUnit.DATA_UNIT_Command_Address.Data_Size = D_DD       '数据类型
     End Select
    .DataUnit.DATA_UNIT_Command_Address.D_H0 = 0
    .DataUnit.DATA_UNIT_Command_Address.Read_Count = n_Count
    .DataUnit.DATA_UNIT_Command_Address.DataBlockNum(0) = 0
    .DataUnit.DATA_UNIT_Command_Address.DataBlockNum(1) = 1
    .DataUnit.DATA_UNIT_Command_Address.Data_Type = &H84
     n_Addr = n_Addr * 8
     tmp_varAddr = n_Addr
     SHR tmp_varAddr, 16
    .DataUnit.DATA_UNIT_Command_Address.Address(0) = tmp_varAddr And &HFF
     tmp_varAddr = n_Addr
     SHR tmp_varAddr, 8
    .DataUnit.DATA_UNIT_Command_Address.Address(1) = tmp_varAddr And &HFF
     tmp_varAddr = n_Addr
     .DataUnit.DATA_UNIT_Command_Address.Address(2) = tmp_varAddr And &HFF
     mData = ComposeRorWdata(m_Reader, n_Type)
     For i = 4 To 30
         tmp_Byte = tmp_Byte + mData(i)
     Next
     tmp_Byte = tmp_Byte Mod 256
    .FCS = tmp_Byte
    .ED = &H16
     .IsWrite = False
     mData = ComposeRorWdata(m_Reader, n_Type)
End With
read_Filed_Data = mData
End Function

Public Function write_filed_Data(n_Type As String, n_Data As Double, n_Addr As Variant, Optional n_Count As Integer = 1) As Variant '写单个单位
Dim m_Write As S7RorWProtocal
Dim tmp_Byte As Variant
Dim mData() As Byte
Dim i As Integer
Dim tmp_varAddr As Long
Dim tmp_Var As Long
With m_Write
    .SD = &H68
    Select Case LCase(n_Type)
        Case "vb"
            .Length = &H21
            .LengthRepeate = &H21
        Case "vw"
            .Length = &H21
            .LengthRepeate = &H21
        Case "vd"
            .Length = &H23
            .LengthRepeate = &H23
     End Select
    .DestinationAddr = 2
    .SourceAddress = 0
    .FunctionCode = &H7C
    .DstSrvAccPt = &H32
    .SrcSrvAccPt = &H1
     ReDim .DataUnit.DATA_UNIT_Command(9)
    .DataUnit.DATA_UNIT_Command(0) = 0
    .DataUnit.DATA_UNIT_Command(1) = 0
    .DataUnit.DATA_UNIT_Command(2) = &HA
    .DataUnit.DATA_UNIT_Command(3) = &HA
    .DataUnit.DATA_UNIT_Command(4) = 0
    .DataUnit.DATA_UNIT_Command(5) = &HE
    .DataUnit.DATA_UNIT_Command(6) = 0
    If LCase(n_Type) = "vd" Then
    .DataUnit.DATA_UNIT_Command(7) = &H8
    Else
    .DataUnit.DATA_UNIT_Command(7) = &H6
    End If
    .DataUnit.DATA_UNIT_Command(8) = &H5                    '  SERVICE_ID
    .DataUnit.DATA_UNIT_Command(9) = &H1
    .DataUnit.DATA_UNIT_Command_Address.Identifier = &H12
    .DataUnit.DATA_UNIT_Command_Address.Command = &HA
    .DataUnit.DATA_UNIT_Command_Address.D_H10 = &H10
     Select Case LCase(n_Type)
        Case "vb"
            .DataUnit.DATA_UNIT_Command_Address.Data_Size = D_DB       '数据类型
        Case "vw"
             .DataUnit.DATA_UNIT_Command_Address.Data_Size = D_DW       '数据类型
        Case "vd"
            .DataUnit.DATA_UNIT_Command_Address.Data_Size = D_DD       '数据类型
     End Select
    .DataUnit.DATA_UNIT_Command_Address.D_H0 = 0
    .DataUnit.DATA_UNIT_Command_Address.Read_Count = n_Count
    .DataUnit.DATA_UNIT_Command_Address.DataBlockNum(0) = 0
    .DataUnit.DATA_UNIT_Command_Address.DataBlockNum(1) = 1
    .DataUnit.DATA_UNIT_Command_Address.Data_Type = &H84
     SHL n_Addr, 3
     tmp_varAddr = n_Addr
     SHR tmp_varAddr, 16
    .DataUnit.DATA_UNIT_Command_Address.Address(0) = tmp_varAddr And &HFF
     tmp_varAddr = n_Addr
     SHR tmp_varAddr, 8
    .DataUnit.DATA_UNIT_Command_Address.Address(1) = tmp_varAddr And &HFF
     tmp_varAddr = n_Addr
     .DataUnit.DATA_UNIT_Command_Address.Address(2) = tmp_varAddr And &HFF
     .IsWrite = True
     .WirteData.DataMode(0) = 0
     .WirteData.DataMode(1) = 4
      Select Case LCase(n_Type)
        Case "vb"
            .WirteData.LengthData(0) = &H0                              '
            .WirteData.LengthData(1) = &H8
            .WirteData.Data(0) = n_Data
            .WirteData.Data(1) = 0
        Case "vw"
            .WirteData.LengthData(0) = &H0                              '
            .WirteData.LengthData(1) = &H10
            .WirteData.Data(0) = n_Data \ 256
            .WirteData.Data(1) = n_Data Mod 256
        Case "vd"
            .WirteData.LengthData(0) = &H0                              '
            .WirteData.LengthData(1) = &H20
             tmp_Var = n_Data
             SHR tmp_Var, 24
            .WirteData.Data(0) = tmp_Var And &HFF
             
             tmp_Var = n_Data
             SHR tmp_Var, 16
            .WirteData.Data(1) = tmp_Var And &HFF
            
             tmp_Var = n_Data
             SHR tmp_Var, 8
            .WirteData.Data(2) = tmp_Var And &HFF
            
             tmp_Var = n_Data
            .WirteData.Data(3) = tmp_Var And &HFF
      End Select
     
     mData = ComposeRorWdata(m_Write, n_Type)
     
     Select Case LCase(n_Type)
        Case "vb"
            For i = 4 To 36
                 tmp_Byte = tmp_Byte + mData(i)
            Next
        Case "vw"
             For i = 4 To 36
                 tmp_Byte = tmp_Byte + mData(i)
             Next
        Case "vd"
            For i = 4 To 38
                 tmp_Byte = tmp_Byte + mData(i)
            Next
       End Select
     
     tmp_Byte = tmp_Byte Mod 256
    .FCS = tmp_Byte
    .ED = &H16
     mData = ComposeRorWdata(m_Write, n_Type)
End With
write_filed_Data = mData
End Function

Public Function read_block_Data() As Variant

End Function

Public Function write_block_Data() As Variant

End Function

Private Function ComposeRorWdata(n_S7rw As S7RorWProtocal, nType As String) As Variant
Dim m_data() As Byte
Dim m_s7Data As S7RorWProtocal
Dim temp_Byte() As Byte
'SD LE LER SD DA SA FC DASP SSAP DU FCS ED
m_s7Data.SD = &H68                               '1
m_s7Data.Length = n_S7rw.Length                  '1
m_s7Data.LengthRepeate = n_S7rw.LengthRepeate    '1
m_s7Data.SD = &H68                               '1
m_s7Data.DestinationAddr = n_S7rw.DestinationAddr '1
m_s7Data.SourceAddress = n_S7rw.SourceAddress     '1
m_s7Data.FunctionCode = n_S7rw.FunctionCode        '1
m_s7Data.DstSrvAccPt = n_S7rw.DstSrvAccPt         '1
m_s7Data.SrcSrvAccPt = n_S7rw.SrcSrvAccPt         '1
m_s7Data.DataUnit = n_S7rw.DataUnit
m_s7Data.WirteData = n_S7rw.WirteData
m_s7Data.IsWrite = n_S7rw.IsWrite
m_s7Data.FCS = n_S7rw.FCS
m_s7Data.ED = &H16
If m_s7Data.IsWrite Then
    Select Case LCase(nType)
        Case "vb"
           ReDim m_data(38)
        Case "vw"
           ReDim m_data(38)
        Case "vd"
           ReDim m_data(40)
     End Select
    Else
    ReDim m_data(32)
End If
m_data(0) = m_s7Data.SD
m_data(1) = m_s7Data.Length
m_data(2) = m_s7Data.LengthRepeate
m_data(3) = m_s7Data.SD
m_data(4) = m_s7Data.DestinationAddr
m_data(5) = m_s7Data.SourceAddress
m_data(6) = m_s7Data.FunctionCode
m_data(7) = m_s7Data.DstSrvAccPt
m_data(8) = m_s7Data.SrcSrvAccPt
m_data(9) = m_s7Data.DataUnit.DATA_UNIT_Command(0)
m_data(10) = m_s7Data.DataUnit.DATA_UNIT_Command(1)
m_data(11) = m_s7Data.DataUnit.DATA_UNIT_Command(2)
m_data(12) = m_s7Data.DataUnit.DATA_UNIT_Command(3)
m_data(13) = m_s7Data.DataUnit.DATA_UNIT_Command(4)
m_data(14) = m_s7Data.DataUnit.DATA_UNIT_Command(5)
m_data(15) = m_s7Data.DataUnit.DATA_UNIT_Command(6)
m_data(16) = m_s7Data.DataUnit.DATA_UNIT_Command(7)
m_data(17) = m_s7Data.DataUnit.DATA_UNIT_Command(8)
m_data(18) = m_s7Data.DataUnit.DATA_UNIT_Command(9)
m_data(19) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.Identifier
m_data(20) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.Command
m_data(21) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.D_H10
m_data(22) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.Data_Size
m_data(23) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.D_H0
m_data(24) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.Read_Count
m_data(25) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.DataBlockNum(0)
m_data(26) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.DataBlockNum(1)
m_data(27) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.Data_Type
m_data(28) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.Address(0)
m_data(29) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.Address(1)
m_data(30) = m_s7Data.DataUnit.DATA_UNIT_Command_Address.Address(2)
If m_s7Data.IsWrite Then
    m_data(31) = m_s7Data.WirteData.DataMode(0)
    m_data(32) = m_s7Data.WirteData.DataMode(1)
    m_data(33) = m_s7Data.WirteData.LengthData(0)
    m_data(34) = m_s7Data.WirteData.LengthData(1)
    Select Case LCase(nType)
        Case "vb"
           m_data(35) = m_s7Data.WirteData.Data(0)
           m_data(36) = m_s7Data.WirteData.Data(1)
           m_data(37) = m_s7Data.FCS
           m_data(38) = m_s7Data.ED
        Case "vw"
           m_data(35) = m_s7Data.WirteData.Data(0)
           m_data(36) = m_s7Data.WirteData.Data(1)
           m_data(37) = m_s7Data.FCS
           m_data(38) = m_s7Data.ED
        Case "vd"
           m_data(35) = m_s7Data.WirteData.Data(0)
           m_data(36) = m_s7Data.WirteData.Data(1)
           m_data(37) = m_s7Data.WirteData.Data(2)
           m_data(38) = m_s7Data.WirteData.Data(3)
           m_data(39) = m_s7Data.FCS
           m_data(40) = m_s7Data.ED
     End Select
    
    ComposeRorWdata = m_data
    Else
    m_data(31) = m_s7Data.FCS
    m_data(32) = m_s7Data.ED
    ComposeRorWdata = m_data
End If

End Function

Public Function GetAckCmd() As Variant            '获得确认命令
Dim m_ack As S7AckProtocal
Dim m_data(0 To 5) As Byte
Dim m_Fcs As Variant
    m_ack.DstAddr = DstAddr
    m_ack.SrcAddr = SrcAddr
    m_ack.ED = &H16
    m_ack.SD = &H10
    m_ack.FunctionCode = &H5C
    m_Fcs = (m_ack.DstAddr + m_ack.SrcAddr + m_ack.FunctionCode) Mod 256
    m_ack.FCS = m_Fcs
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    m_data(0) = m_ack.SD
    m_data(2) = m_ack.SrcAddr
    m_data(1) = m_ack.DstAddr
    m_data(3) = m_ack.FunctionCode
    m_data(4) = m_ack.FCS
    m_data(5) = &H16
    GetAckCmd = m_data
End Function