module1.bas

电能表抄表软件,基本符合国家颁布的DL645通讯规约,去除了一些不必要的功能

Attribute VB_Name = "Module1"

Dim STR() As Byte '拼装每条命令时，临时存放数组
Public send_r() As Variant '所有的抄表命令字，存放在数组send_r(30)中，不抄的命令也占用一个数组元素，只是将该元素的长度设为零。即长度为零的字段为不抄的项目



Public Sub get_tybh(ss As TextBox, bh)
        Dim x0, y0 As Byte
        x0 = Val(Mid(ss.Text, 11, 1)): y0 = Val(Mid(ss.Text, 12, 1))
        bh(0) = (x0 * 16 + y0)
        x0 = Val(Mid(ss.Text, 9, 1)): y0 = Val(Mid(ss.Text, 10, 1))
        bh(1) = (x0 * 16 + y0)
        x0 = Val(Mid(ss.Text, 7, 1)): y0 = Val(Mid(ss.Text, 8, 1))
        bh(2) = (x0 * 16 + y0)
        x0 = Val(Mid(ss.Text, 5, 1)): y0 = Val(Mid(ss.Text, 6, 1))
        bh(3) = (x0 * 16 + y0)
        x0 = Val(Mid(ss.Text, 3, 1)): y0 = Val(Mid(ss.Text, 4, 1))
        bh(4) = (x0 * 16 + y0)
        x0 = Val(Mid(ss.Text, 1, 1)): y0 = Val(Mid(ss.Text, 2, 1))
        bh(5) = (x0 * 16 + y0)
End Sub
'拼装抄表命令字，存放在数组send_r(30)中，长度为零的字段不抄
 Public Sub copy_Com(check, bh, mm, nn)
ReDim STR(15), send_r(31)
'填固定项
   STR(0) = &HFE: STR(1) = &HFE: STR(2) = &H68
   STR(9) = &H68: STR(10) = &H1
   STR(11) = &H2: STR(15) = &H16
   For i = 0 To 5           '填表号
    STR(i + 3) = bh(i)
   Next
      For i = mm To nn
   If check(i).Value = vbChecked Then ' 如果当前项被选中则拼装命令
      Select Case i
    Case 1 '读当前有功电量
         STR(12) = &H52 '1F+33:
        STR(13) = &HC3 '90+33 :
    Case 2 '读反向累计电量
        STR(12) = &H62: STR(13) = &HC3
        
    Case 3 '读上月有功电量
        STR(12) = &H52: STR(13) = &HC7
        
    Case 4 '读上上月有功电量
        STR(12) = &H52: STR(13) = &HCB
        
    Case 5 '读历史记录3=03月电量
         STR(12) = &H52: STR(13) = &H16
        
    Case 6 '读历史记录4=04月电量
         STR(12) = &H62: STR(13) = &H16
       
    Case 7 '读历史记录5=05月电量
         STR(12) = &H72: STR(13) = &H16
       
    Case 8 '读历史记录6=06月电量
         STR(12) = &H82: STR(13) = &H16
        
    Case 9 '读历史记录7=07月电量
         STR(12) = &H92: STR(13) = &H16
        
    Case 10 '读历史记录8=08月电量
         STR(12) = &HA2: STR(13) = &H16
        
    Case 11 '读历史记录9=09电量
         STR(12) = &HB2: STR(13) = &H16
        
    Case 12 '读历史记录10=10月电量
         STR(12) = &HC2: STR(13) = &H16
        
    Case 13 '读历史记录11=11月电量
         STR(12) = &HD2: STR(13) = &H16
        
    Case 14 '读历史记录12=12月电量
         STR(12) = &HE2: STR(13) = &H16
        
    'Case 15 '读最近编程时间
         STR(12) = &H43: STR(13) = &HE5
        
    Case 16 '读最近清零时间
         STR(12) = &H4D: STR(13) = &HE5
        
    Case 17 '读编程次数
         STR(12) = &H45: STR(13) = &HE5
        
    Case 18 '读清零次数
         STR(12) = &H4E: STR(13) = &HE5
        
    Case 19 '读时间
            STR(12) = &H44: STR(13) = &HF3
            
    Case 20 '读日期和星期
         STR(12) = &H43: STR(13) = &HF3
         
    Case 21 '读自动读表日
         STR(12) = &H4A: STR(13) = &HF4
     
    Case 22 '读循显时间
         STR(12) = &H46: STR(13) = &HF4
    
    Case 23 '读表号
         STR(12) = &H65: STR(13) = &HF3
              
    Case 24 '读设备码
         STR(12) = &H67: STR(13) = &HF3
         
    Case 25 '读循环显示项目数
         STR(12) = &H63: STR(13) = &HF4
        
    Case 26 '读第01项循环显示项目
         STR(12) = &H43: STR(13) = &HF9
    
    Case 27 '读第02项循环显示项目
         STR(12) = &H44: STR(13) = &HF9
    
    Case 28 '读第03项循环显示项目
         STR(12) = &H45: STR(13) = &HF9
     
    Case 29 '读第04项循环显示项目
         STR(12) = &H46: STR(13) = &HF9
    
    Case 30 '读电流反向事件1起始时间结束时间
         STR(12) = &H43: STR(13) = &H15
        
    
    
    
    End Select
         SUM1 = 0    '求和
        For n = 2 To 13
        SUM1 = SUM1 + STR(n)
        Next
        STR(14) = SUM1 Mod 256
            If i = 25 Then
                send_r(26) = STR()
            Else
                send_r(i - 1) = STR()
            End If
    End If
  Next
End Sub

Public Function myweekday() As String
Dim myweek As VbDayOfWeek
Dim weekchr(7) As String * 1
weekchr(1) = "日": weekchr(2) = "一": weekchr(3) = "二": weekchr(4) = "三"
weekchr(5) = "四": weekchr(6) = "五": weekchr(7) = "六"
myweek = Weekday(Date)
myweekday = "星期" & weekchr(myweek)
End Function
Public Function key_value(a_ascii As Integer) As Integer
Dim mychr As String * 1
 key_value = a_ascii
 If a_ascii <> 8 Then
    mychr = Chr(a_ascii)
    If ("0" > mychr) Or (mychr > "9") Then key_value = 0
 End If
End Function
Public Sub OnErrStatement(title As String)
'检查可能发生的错误。
   Dim msg As String
   
   Select Case Err.Number
     Case 1
      msg = "广播表号失败，请检查串口号及线路连接是否正确。"
    
    Case 621
      msg = "无有效选择项。"
    Case 630
        msg = "应答超时。请检查串口号及线路连接是否正确."
    Case 631
      msg = "应答命令错误。"
                     
End Select
      MsgBox msg, vbExclamation, title '错误信息，一个确认键，标题栏文本
      MARK = 0: end_s = True
      
End Sub


Public Sub set_replay(aray() As Byte, INF)
Dim cx As Byte
Dim SUM1 As Integer
cx = UBound(aray()) '接收的字节数
If cx < 10 Then GoTo ERR_123
k = 0
'寻找FEH,68H开始的有效应答信号
Do
k = k + 1
Loop Until ((aray(k - 1) = 254) And (aray(k) = 104)) Or (k = cx)
'如果找到了，求和
SUM1 = 0
If (k < cx) Then
j = k + 9 + aray(k + 9)
If j > cx Then GoTo ERR_123 '如果接收到的数据长度<应答命令给出的数据长度，说明应答命令错误
For n = k To j
        SUM1 = SUM1 + aray(n)
        Next
        SUM1 = SUM1 Mod 256
        If SUM1 <> aray(n) Then
            frm_msg.ForeColor = &HFF&
          frm_msg.Print INF & "失败" 'COM_MSG(ii + 1) & "失败"
          frm_msg.ForeColor = &H0&
        Else
            frm_msg.ForeColor = &H0&
          frm_msg.Print INF & "成功" 'COM_MSG(ii + 1) & "成功"
        End If
Else
ERR_123:
frm_msg.ForeColor = &HFF&
frm_msg.Print INF & "失败" 'COM_MSG(ii + 1) & "失败"
frm_msg.ForeColor = &H0&
End If
End Sub