www.pudn.com > 645-485.rar > DataOperate.cls, change:2007-09-27,size:11442b


VERSION 1.0 CLASS 
BEGIN 
  MultiUse = -1  'True 
  Persistable = 0  'NotPersistable 
  DataBindingBehavior = 0  'vbNone 
  DataSourceBehavior  = 0  'vbNone 
  MTSTransactionMode  = 0  'NotAnMTSObject 
END 
Attribute VB_Name = "DataOperate" 
Attribute VB_GlobalNameSpace = True 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = True 
'**************************************************************************** 
'人人为我,我为人人 
'枕善居收藏整理 
'发布日期:2007/09/27 
'描    述:电表业645规约的电表485通讯程序 
'网    站:http://www.Mndsoft.com/  (VB6源码博客) 
'网    站:http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005) 
'e-mail  :Mndsoft@163.com 
'e-mail  :Mndsoft@126.com 
'OICQ    :88382850 
'          如果您有新的好的代码别忘记给枕善居哦! 
'**************************************************************************** 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
 
' 本模块针对 645 规约开发 
' 作者:沈礼礼 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Option Explicit 
Private Declare Function GetTickCount Lib "kernel32" () As Long 
Private varSend  As Variant 
Private varRecive As Variant 
Public Flag_Comm485 As Boolean   'True:端口占用 
 
Public Function DataSend(Com485 As Object, StrAddress As String, CortrolAndLength As String, StrSendData As String, Delay_ByteMedulla As Long, Delay_FrameMedulla As Double, Responsion_Length As Long) As String 
 
    '本过程向电表发送规约来接收数据 
     
    'StrAddress                 :  表通讯地址 
    'CortrolAndLength           :  控制码和数据长度 
    'StrSendData                :  发送的数据部分    ( 数据标识 + 密码 + 数据 ) 
    'Delay_ByteMedulla          :  字节间延时(毫秒) 
    'Delay_FrameMedulla         :  帧发送完后延时(秒) 
    'Responsion_Length          :  应答帧长度 
 
If Flag_Comm485 = True Then  '数据通讯中 
 
On Error Resume Next 
     
    Dim tmpi As Long 
    Dim ByteBuf(1 To 1) As Byte 
    Dim ArrByte() As Byte                             '要发送的字节数组 
    Dim LngDataLength As Long                         '帧长度 
    Dim StrCortrol As String, StrLength As String     '控制码   '数据长度 
    StrCortrol = Mid(CortrolAndLength, 1, 2) 
    StrLength = Right(CortrolAndLength, 2) 
    LngDataLength = 14 + Val("&H" & StrLength) 
    ReDim ArrByte(1 To LngDataLength) As Byte 
    Dim StrbufModu As String 
    Dim SumMod As Long 
    Dim Ch As Byte 
    Dim I As Long 
    Dim MsgB As String 
    Dim MsgT As Long 
    Dim LngCount As Long                              '接受到的字节数 
    Dim MiaoTmp1 As Double, MiaoTmp2 As Double        '等待开始时间和等待时间 
    Dim Gobz As Boolean 
    MsgT = 0 
    Gobz = False 
    LngCount = 0 
    MsgB = "" 
    Responsion_Length = 0 
 
    ArrByte(1) = &HFE 
    ArrByte(2) = &HFE 
     
    ArrByte(3) = &H68 
     
    If Len(StrAddress) = 12 Then                     ' 发送的地址 
        ArrByte(4) = "&H" & Mid(StrAddress, 11, 2) 
        ArrByte(5) = "&H" & Mid(StrAddress, 9, 2) 
        ArrByte(6) = "&H" & Mid(StrAddress, 7, 2) 
        ArrByte(7) = "&H" & Mid(StrAddress, 5, 2) 
        ArrByte(8) = "&H" & Mid(StrAddress, 3, 2) 
        ArrByte(9) = "&H" & Mid(StrAddress, 1, 2) 
    End If 
     
    ArrByte(10) = &H68 
     
    ArrByte(11) = "&H" & StrCortrol                 ' 如 读:01 / 写:04 
    ArrByte(12) = "&H" & StrLength                  ' 长度 = 02H + M(数据项长度) + 4字节密码   (如:读(0102)->2位(DI0|DI1)+无后续,(0A06)写设备地址->6位地址) 
     
    For tmpi = 1 To Val("&H" & StrLength) 
        ArrByte(12 + tmpi) = "&H" & Mid(StrSendData, 2 * tmpi - 1, 2)  '发送的数据项 (未加 33H ! ---> 针对写电量等操作) 
    Next tmpi 
     
    SumMod = 0 
    For tmpi = 3 To (LngDataLength - 2) 
        SumMod = SumMod + ArrByte(tmpi) 
    Next tmpi 
    ArrByte(LngDataLength - 1) = SumMod Mod 256     ' CS 位处理 
     
    ArrByte(LngDataLength) = &H16                   ' 结束标志 
 
    Com485.Settings = "1200,E,8,1" 
    Com485.InputMode = comInputModeBinary 
    If Com485.PortOpen = False Then Com485.PortOpen = True 
    Com485.InBufferCount = 0 
 
    For tmpi = 1 To LngDataLength 
        ByteBuf(1) = ArrByte(tmpi) 
        Com485.Output = ByteBuf 
        Delay Delay_ByteMedulla 
    Next tmpi 
     
    MiaoTmp1 = Timer 
    Do 
        DoEvents 
        If LngCount = 10 Then 
            Responsion_Length = 10 + Ch + 2 
        End If 
        If Responsion_Length <> 0 Then 
            If LngCount >= Responsion_Length Then Exit Do 
        End If 
        MiaoTmp2 = Timer - MiaoTmp1 
        If MiaoTmp2 > Delay_FrameMedulla Then Exit Do 
        With Com485 
        If .InBufferCount > 0 Then 
          StrbufModu = .Input 
          If LenB(StrbufModu) > 0 Then 
            For I = 1 To LenB(StrbufModu) 
                Ch = AscB(MidB(StrbufModu, I, 1)) 
                If Ch = 104 Then Gobz = True 
                If Gobz = True Then 
                    MsgB = MsgB & Right("000" & Ch, 3) 
                    LngCount = LngCount + 1 
                    If LngCount <= 10 Or LngCount <= Responsion_Length - 2 Then 
                        MsgT = MsgT + CLng(Ch) 
                    End If 
                End If 
            Next I 
          End If 
       End If 
       End With 
       DoEvents 
    Loop 
     
    MsgT = MsgT Mod 256 
    If Len(MsgB) < 36 Then 
        MsgB = "" 
    Else 
        If CLng(Mid(MsgB, 22, 3)) <> 104 Then 
            MsgB = "" 
        End If 
    End If 
     
    DataSend = MsgB                               '接收到的数据 ---> 待处理 
     
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    Debug.Print 
    Debug.Print "Send ---> " 
    For I = 1 To LngDataLength 
     Debug.Print Right("00" & Hex(ArrByte(I)), 2) & " "; 
    Next I 
    Debug.Print 
    Debug.Print "Receive--->  " & CStr(MsgB) 
 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
End If 
 
End Function 
 
Public Function ReceiveData_Operate(ReceiveData As String, StrFormat As String, DataLength As String) As String 
     
    '本过程针对接收到的数据进行处理返回用户需要的数据格式 
     
    'ReceiveData                   :  接收到的数据 
    'StrFormat                     :  返回的数据格式 如 电量格式为:"NNNNNN.NN" 
    'DataLength                    :  数据项长度 
     
On Error GoTo ErrMsg 
 
   Dim K, P As Integer 
   Dim tmp, Sll, SZ As String 
 
   Sll = "" 
   If ReceiveData <> "" Then 
       If Mid(ReceiveData, 1, 3) = "104" And Val(Right(ReceiveData, 3)) = 22 Then  '验证收到信息是否正确 
        
           '对接受到的数据进行处理,返回用户数据 
           Dim Data_Msg As String 
           Data_Msg = Right(ReceiveData, Val(DataLength) * 3 + 6)                  '收到的数据=最后6位(CS+结束位) + 数据项长度*3 
           Data_Msg = Mid(Data_Msg, 1, Len(Data_Msg) - 6) 
            
           For K = 1 To Len(Data_Msg) / 3 
               tmp = Right("00" & Hex(Mid(Data_Msg, 3 * (K - 1) + 1, 3) - 51), 2)  '接收到的数据按位减33H 
               Sll = tmp & Sll                                                     '收到的数据为逆序,应再逆序处理 
           Next K 
  
           P = 1 
           For K = 1 To Len(Trim(StrFormat))                                       '针对相应格式返回用户数据 (如 读总电量9010格式"NNNNNN.NN"  --> 返回 "000098.67") 
               tmp = Mid(Trim(StrFormat), K, 1) 
               Select Case UCase(tmp) 
                  Case "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0" 
                     SZ = Mid(Sll, P, 1) 
                     ReceiveData_Operate = ReceiveData_Operate & SZ 
                     P = P + 1 
                  Case Else                                                        '处理 中文字符/特殊字符/空格 等,直接将其加上显示出 如 901F:“ 总NNNNNN.NN峰NNNNNN.NN平NNNNNN.NN谷NNNNNN.NN ” 显示为“ 总000043.05峰000000.00平000043.05谷000000.00 ” 
                     ReceiveData_Operate = ReceiveData_Operate & tmp 
               End Select 
           Next K 
       Else 
           ReceiveData_Operate = "" 
       End If 
   Else 
       ReceiveData_Operate = "" 
   End If 
 
Exit Function 
     
ErrMsg: 
   MsgBox (Err.Description) 
   
End Function 
 
Public Function DataPart(Identifier As String, Password As String, MyData As String, StrFormat As String, Optional ByVal IsRead As Boolean = True) As String 
   
  '本过程针对发送数据的预处理 
   
  '发送数据格式                   :  数据项标识 + 写入的密码 + 待写入的数据 
   
  'IsRead                         :  定义为判断读写操作 (写电量标识发送 5213 , 并且数据位不加33H) 
  'Identifier                     :  数据项标识 
  'Password                       :  写入的密码 
  'MyData                         :  待写入的数据 
  'StrFormat                      :  数据格式-->发送数据格式化,如地址“ 123 -> 000000000123 ” 
   
If Flag_Comm485 = False Then 
  Flag_Comm485 = True 
    
  Dim K, P As Integer 
  Dim tmp, tt, temp, Str As String 
   
  'Identifier 
  If Identifier <> "" Then 
    If IsRead = True Then  '读                       ' 读操作按字节+33H操作 
      DataPart = IIf((Val("&H" & Mid(Identifier, 3, 2)) + 51) > 255, Right("00" & Hex(Val("&H" & Mid(Identifier, 3, 2)) + 51 - 256), 2), Right("00" & Hex(Val("&H" & Mid(Identifier, 3, 2)) + 51), 2)) & IIf((Val("&H" & Mid(Identifier, 1, 2)) + 51) > 255, Right("00" & Hex(Val("&H" & Mid(Identifier, 1, 2)) + 51 - 256), 2), Right("00" & Hex(Val("&H" & Mid(Identifier, 1, 2)) + 51), 2)) 
    Else                   '写                       ' 写操作 [标识码] 需要在数据库中手动加入 33H 
      DataPart = Mid(Identifier, 3, 2) & Mid(Identifier, 1, 2) 
    End If 
  End If 
   
  'Password                                          ' 按字节 +33H 
  If Password <> "" Then 
    tmp = "" 
    For K = 1 To Len(Password) Step 2 
       tmp = IIf((Val("&H" & Mid(Password, K, 2)) + 51) > 255, Right("00" & Hex(Val("&H" & Mid(Password, K, 2)) + 51 - 256), 2), Right("00" & Hex(Val("&H" & Mid(Password, K, 2)) + 51), 2)) & tmp 
    Next K 
    DataPart = DataPart & tmp 
  End If 
   
  '1.数据格式化 2.逆序处理                           ' 按字节 +33H 
  Str = "" 
  If MyData <> "" And StrFormat <> "" Then 
   
    tmp = "" 
    temp = "" 
    tmp = StringFormat(MyData, StrFormat)            ' 数据格式化 
     
    For K = 1 To Len(tmp)                            ' 去除特殊符号 
       tt = Mid(Trim(tmp), K, 1) 
       If IsNumber(tt) = True Then temp = temp & tt 
    Next K 
 
    Select Case UCase(Trim(Identifier)) 
     
        Case "1352", "1362"                          ' 写电量操作例外,数据位不加 33H! 如 (写正向有功电量: FE 68 99 99 99 99 99 99 68 16 0B 52 13 33 33 33 33 AA [01 11 11 11]  '[]内为数据  ) 
            For K = 1 To Len(temp) Step 2            ' 逆序处理 [数据需逆序发送] 
               Str = Mid(temp, K, 2) & Str           ' 写电量数据位不加 33H 处理 
            Next K 
 
        Case Else 
            For K = 1 To Len(temp) Step 2            ' 逆序处理 [数据需逆序发送] 
               Str = IIf((Val("&H" & Mid(temp, K, 2)) + 51) > 255, Right("00" & Hex(Val("&H" & Mid(temp, K, 2)) + 51 - 256), 2), Right("00" & Hex(Val("&H" & Mid(temp, K, 2)) + 51), 2)) & Str 
            Next K 
             
    End Select 
     
  End If 
   
  ' 
  DataPart = DataPart & Str 
   
End If 
 
End Function