⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 广播设置.frm

📁 vb串口编程电表读数 vb串口编程电表读数 vb串口编程电表读数 vb串口编程电表读数
💻 FRM
📖 第 1 页 / 共 3 页
字号:
  Dim STR() As Byte
  Dim GB_CMD(19) As Byte
  Dim GLB(5) As Byte
  Private Sub FILL_BH() '填广播表号,校时固定项
  STR(0) = &HFE: STR(1) = &HFE: '起始位符
  STR(2) = &H68: STR(9) = &H68: '命令帧,数据帧起始符
  STR(11) = &H6:  STR(19) = &H16:
  For n = 3 To 8
  STR(n) = &H99
  Next
  End Sub
   

'广播表号命令发送'
Private Sub Command1_Click()

 If MARK = 0 Then
 MARK = 1
 end_s = False
 ReDim STR(19)
 Dim X1 As Byte
 Dim Y1 As Byte
 Dim z1 As Integer
 FILL_BH '填表号
  STR(10) = &HA
  '取表号
  If Option1.Value Then
        If Len(Text7.Text) <> 6 Then
LINE_ERR1:      Err.Number = 2
line_err2:      OnErrStatement (mtitle)
                Exit Sub
        End If
        Call GET_jsBH(Text7, Combo1, Combo2, GLB) '填江苏表号
    Else
        If Len(Text8.Text) <> 12 Then GoTo LINE_ERR1
        Call get_tybh(Text8, GLB)
    End If
        For n = 0 To 5
        STR(n + 12) = GLB(n) + &H33
        Next
  '求累加和
  z1 = 0
  For n = 2 To 17
  z1 = z1 + STR(n)
  Next
  STR(18) = z1 Mod 256
  num = 1
Call send_com
End If
End Sub

'广播校时命令发送
Private Sub Command2_Click()

If MARK = 0 Then
 MARK = 1: end_s = False
 ReDim STR(19)
 FILL_BH '填表号
    STR(10) = &H8
    '取日,月,年
    TT = DateAdd("S", 2, Date + Time) '当前设置时间加补偿2秒钟
   
                
        X1 = DatePart("d", TT)
        STR(15) = ((X1 \ 10) * 16 + X1 Mod 10) + &H33 '日
        X1 = DatePart("m", TT)
        STR(16) = ((X1 \ 10) * 16 + X1 Mod 10) + &H33   '月
         X1 = DatePart("yyyy", TT) Mod 100
        STR(17) = ((X1 \ 10) * 16 + X1 Mod 10) + &H33 '年
    '取秒,分,时
        
        X1 = DatePart("n", TT)
        STR(13) = ((X1 \ 10) * 16 + X1 Mod 10) + &H33 '分
        X1 = DatePart("h", TT)
        STR(14) = ((X1 \ 10) * 16 + X1 Mod 10) + &H33 '时
        X1 = DatePart("S", TT)
        STR(12) = ((X1 \ 10) * 16 + X1 Mod 10) + &H33 '秒
  
   '求累加和
  z1 = 0
  For n = 2 To 17
  z1 = z1 + STR(n)
  Next
  STR(18) = z1 Mod 256
  num = 2
  Call send_com
  End If
End Sub
Private Function GBREAD_PZH(GBSTR)
'填固定项
   GBSTR(0) = &HFE: GBSTR(1) = &HFE: GBSTR(2) = &H68
    For i = 3 To 8          '填表号
    GBSTR(i) = &HAA
    Next
    GBSTR(9) = &H68: GBSTR(10) = &H1: GBSTR(11) = &H2
    GBSTR(13) = &HF3: GBSTR(15) = &H16


   '读日期和星期
   GBSTR(12) = &H43:   GBSTR(14) = &H5 '累加和
   send_r(0) = GBSTR
   Text9.ForeColor = &H80000008 '黑色字
   '读时间,22
   GBSTR(12) = &H44: GBSTR(14) = &H6 '累加和
   send_r(1) = GBSTR
   Text11.ForeColor = &H80000008
   '读电表运行状态,23
   num = 5:
   GBSTR(12) = &H53: GBSTR(14) = &H15 '累加和
   send_r(2) = GBSTR
   Text10.ForeColor = &H80000008
   End Function

'广播读电表当前时间
Private Sub Command3_Click()
If MARK = 0 Then
end_s = False
MARK = 1
ReDim STR(15), send_r(2)
GBREAD_PZH (STR)
num = 3
STR = send_r(0)
Call send_com
End If

End Sub
'广播读电表运行状态字
Private Sub Command4_Click()
If MARK = 0 Then
end_s = False
MARK = 1
ReDim STR(15), send_r(2)
GBREAD_PZH (STR)
STR = send_r(2)
Call send_com
End If

End Sub

Private Sub send_com()
 
If num < 3 Then
        BYTE_N1 = 20
Else
        BYTE_N1 = 16
End If

  MSComm1.CommPort = B_COMPORT
  If MSComm1.PortOpen Then MSComm1.PortOpen = False
  
  MSComm1.OutBufferSize = 1
          On Error Resume Next
        MSComm1.PortOpen = True
        If Err.Number = 8002 Then
            MsgBox "通讯端口号错误!", vbExclamation, "广播设置" '错误信息,一个确认键,标题栏文本
            MARK = 0
            end_s = True
            Exit Sub
        End If
 
  MSComm1.RTSEnable = False '使用丕希485接口时用该语句切换到发送状态。
  
  MSComm1.InBufferCount = 0
  MSComm1.RThreshold = 0 '1
  
  BYTE_N2 = 0
  Label1.Visible = False
  Label6.Visible = False
  Label32.Visible = True
  ProgressBar1.Visible = True
  Timer1.Enabled = True
End Sub


 Private Sub Form_Load()
   Combo1.ListIndex = 25
  Combo2.ListIndex = 2

  Text6.Text = Year(Date)
  Text5.Text = Month(Date)
  Text4.Text = Day(Date)
  Text3.Text = Hour(Time)
  Text2.Text = Minute(Time)
  Text1.Text = Second(Time)
   mtitle = "广播命令"
  End Sub

Private Sub Form_Unload(Cancel As Integer)
  If MSComm1.PortOpen Then MSComm1.PortOpen = False
End Sub

'接收应答
Private Sub MSComm1_OnComm()
  Dim ARR() As Byte
If MSComm1.CommEvent = comEvReceive Then
        ARR = MSComm1.Input
        GB_CMD(NNN) = ARR(0)
        NNN = NNN + 1
Select Case num

Case 3 '广播读日期命令应答
        If NNN > 18 Then       '此处应为NNN >18 才能收到结束符,留待以后解决???
         Timer3.Enabled = False    '关闭广播表号应答延时时间监视定时器)
        z1 = 0
        For n = 1 To 16
        z1 = GB_CMD(n) + z1
        Next
        If MSComm1.PortOpen Then MSComm1.PortOpen = False
        If GB_CMD(17) = (z1 Mod 256) Then
        bx = (GB_CMD(16) - &H33) \ 16: cx = (GB_CMD(16) - &H33) Mod 16 '年
        dx = (GB_CMD(15) - &H33) \ 16: ex = (GB_CMD(15) - &H33) Mod 16 '月
        fx = (GB_CMD(14) - &H33) \ 16: gx = (GB_CMD(14) - &H33) Mod 16 '日
        hx = (GB_CMD(13) - &H33) Mod 16 '星期
        Text11.ForeColor = &HFF&
        Text11.Text = CStr(bx) + CStr(cx) + "-" + CStr(dx) + CStr(ex) + "-" + CStr(fx) + CStr(gx) + "-" + CStr(hx)
        num = 4
        STR = send_r(1)
        Call send_com       '拼装读时间的命令
        Else
                err_number = 631
                OnErrStatement (mtitle)
                MARK = 0
                end_s = True
                Exit Sub
        End If
        End If
Case 4 '广播读时间命令应答
        If NNN > 17 Then
            Timer3.Enabled = False
            ProgressBar1.Value = Max
            z1 = 0
            For n = 1 To 15
            z1 = GB_CMD(n) + z1
            Next
            MSComm1.PortOpen = False
            MARK = 0
            Timer2.Enabled = True
            ProgressBar1.Visible = False
            Label32.Visible = False
  
            If GB_CMD(16) = (z1 Mod 256) Then
                bx = (GB_CMD(15) - &H33) \ 16: cx = (GB_CMD(15) - &H33) Mod 16 '时
                dx = (GB_CMD(14) - &H33) \ 16: ex = (GB_CMD(14) - &H33) Mod 16 '分
                fx = (GB_CMD(13) - &H33) \ 16: gx = (GB_CMD(13) - &H33) Mod 16 '秒
                Text9.ForeColor = &HFF&
                Text9.Text = CStr(bx) + CStr(cx) + ":" + CStr(dx) + CStr(ex) + ":" + CStr(fx) + CStr(gx)
            Else
                err_number = 631
                OnErrStatement (mtitle)
                MARK = 0
                end_s = True
                Exit Sub
            End If
        End If
Case 5 '广播读状态
        If NNN > 15 Then

            ProgressBar1.Value = Max
            Timer3.Enabled = False
            Timer2.Enabled = True
            z1 = 0
            For n = 1 To 13
            z1 = GB_CMD(n) + z1
            Next
            MSComm1.PortOpen = False
            MARK = 0
            end_s = True
            ProgressBar1.Visible = False
            Label32.Visible = False
            If GB_CMD(14) = (z1 Mod 256) Then
                Text10.ForeColor = &HFF&
                bx = (GB_CMD(13) - &H33) \ 16:
                If (bx And &H2) = 0 Then
                Text10.Text = "校时禁止"
                Else: Text10.Text = "校时允许"
                End If
            End If
        End If
Case 1 '广播表号
        If NNN > 12 Then
            Timer3.Enabled = False
            ProgressBar1.Value = Max
            z1 = 0
            For n = 1 To 10
            z1 = GB_CMD(n) + z1
            Next
        MSComm1.PortOpen = False
        MARK = 0: end_s = True
        Timer2.Enabled = True
        ProgressBar1.Visible = False
        Label32.Visible = False
        Label1.Visible = True
        If GB_CMD(11) = (z1 Mod 256) Then
            Label1.Visible = True
        Else
            err_number = 1
            OnErrStatement (mtitle)
            MARK = 0
            end_s = True
            Exit Sub
        End If
        End If
End Select

End If
End Sub

Private Sub Option1_Click()
Text8.Enabled = False
Label18.Enabled = False
Text7.Enabled = True
Combo1.Enabled = True
Combo2.Enabled = True
Label7.Enabled = True
Label8.Enabled = True
Label17.Enabled = True
mydata.bh = Text7.Text + Combo1.Text + Combo2.Text + "AA"

End Sub

Private Sub Option2_Click()

Text8.Enabled = True
Label18.Enabled = True
Text7.Enabled = False
Combo1.Enabled = False
Combo2.Enabled = False
Label7.Enabled = False
Label8.Enabled = False
Label17.Enabled = False
mydata.bh = Text8.Text
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
KeyAscii = key_value(KeyAscii)
End Sub
Private Sub Text8_KeyPress(KeyAscii As Integer)
KeyAscii = key_value(KeyAscii)
End Sub
Private Sub Text7_LostFocus()
Text7.Text = String(Text7.MaxLength - Len(Text7.Text), "0") + Text7.Text
mydata.bh = Text7.Text + Combo1.Text + Combo2.Text + "AA"
End Sub
Private Sub Text8_LostFocus()
Text8.Text = String(Text8.MaxLength - Len(Text8.Text), "0") + Text8.Text
mydata.bh = Text8.Text
End Sub
Private Sub Combo1_LostFocus()
mydata.bh = Text7.Text + Combo1.Text + Combo2.Text + "AA"
End Sub
Private Sub Combo2_LostFocus()
mydata.bh = Text7.Text + Combo1.Text + Combo2.Text + "AA"
End Sub
Private Sub Timer1_Timer()
Dim ARRR(20) As Byte

ARRR(0) = STR(BYTE_N2)
MSComm1.Output = ARRR
BYTE_N1 = BYTE_N1 - 1
BYTE_N2 = BYTE_N2 + 1

ProgressBar1.Value = BYTE_N2
If BYTE_N1 = 0 Then
Timer1.Enabled = False
    If STR(10) <> 8 Then
        Timer4.Enabled = True       '等待10ms发送完最后一个字节
    Else
        MSComm1.PortOpen = False
        MARK = 0
        end_s = True
        ProgressBar1.Visible = False
        Label32.Visible = False
        Label6.Visible = True
    End If
End If
End Sub
Private Sub TIMER4_TIMER()      '10ms后启动等待广播表号应答延时时间监视定时器)
Timer3.Interval = 500
Timer3.Enabled = True
MSComm1.RTSEnable = True        '使用丕希485接口时用该语句打开接收。
NNN = 0
MSComm1.InBufferCount = 0
MSComm1.RThreshold = 1
Timer4.Enabled = False
End Sub

    
Private Sub timer3_timer()      '应答超时
    Timer3.Enabled = False
    MSComm1.PortOpen = False
    MARK = 0
    end_s = True
    ProgressBar1.Visible = False
    Label32.Visible = False
    Err.Number = 630
    OnErrStatement (mtitle) '广播表号通讯失败
        
End Sub
      
Private Sub Timer2_Timer()
  Text3.Text = Hour(Time)
  Text2.Text = Minute(Time)
  Text1.Text = Second(Time)
End Sub


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -