form1.frm

串口通信从程序,一个自己编写的串口通讯程序结合串口通信主程序进行运作.

    
        'ReDim backdata(9) As Byte
    '****************************************head
            backdata(1) = &HEB
            backdata(2) = &H90
            backdata(3) = &HEB
            backdata(4) = &H90
            backdata(5) = &H2
    '****************************************addr
            backdata(6) = &H1
    '****************************************info
            backdata(8) = &H1
            backdata(9) = &H1
    '********************************************content
    
        Select Case no
           
           Case 1 '************************************************ack
               backdata(7) = &H6
               packlen = 13
               
               'ReDim Preserve backdata(packlen) As Byte
               backdata(packlen - 3) = &H4
           Case 2 '************************************************nck
               backdata(7) = &H15
               packlen = 13
               
               'ReDim Preserve backdata(packlen) As Byte
               backdata(packlen - 3) = &H4
           Case 3 '*************************************************trouble
               backdata(7) = &H40
               packlen = 13 + 1 + chsum
               reallen = packlen - 9
               
               'ReDim Preserve backdata(packlen) As Byte
               backdata(10) = reallen
               backdata(11) = chsum
               
               For i = 12 To packlen - 3
                 backdata(i) = trouble(i - 11)
               Next i
           Case 4 '**************************************************pcdata
               backdata(7) = &H41
               packlen = 13 + 1 + 2 * chsum
               reallen = packlen - 9
               
               'ReDim Preserve backdata(packlen) As Byte
               backdata(10) = reallen
               backdata(11) = chsum
               
               l = 0
               For i = 12 To packlen - 3 Step 2
               l = l + 1
                 Call qvalue(backdata, (i), (l))
               Next i
           Case 5 '**************************************************ndata
               backdata(7) = &H42
               packlen = 13 + 1 + chsum
               reallen = packlen - 9
               
               'ReDim Preserve backdata(packlen) As Byte
               backdata(10) = reallen
               backdata(11) = chsum
               
               For i = 12 To packlen - 3
                 backdata(i) = ndata(i - 11)
               Next i
           Case 6 '***************************************************all
               backdata(7) = &H43
               packlen = 13 + 1 + chsum + 2 * chsum + chsum
               reallen = packlen - 9
               
               'ReDim Preserve backdata(packlen) As Byte
               backdata(10) = reallen
               backdata(11) = chsum
               
               For i = 12 To 12 + chsum - 1
                 backdata(i) = trouble(i - 11)
               Next i
               l = 0
               For j = 12 + chsum To packlen - 3 - chsum Step 2
                 l = l + 1
                 Call qvalue(backdata, (j), (l))
               Next j
               
               For k = packlen - 2 - chsum To packlen - 3
                  backdata(k) = ndata(k - (packlen - 3 - chsum))
               Next k
               
          End Select
     
               sump = sum_p(backdata, packlen)
               sumstr = Right("0000" + Hex(sump), 4)
               lhex = Right(sumstr, 2)
               hhex = Left(sumstr, 2)
               backdata(packlen - 2) = str_hex(lhex)
               backdata(packlen - 1) = str_hex(hhex)
  '****************************************************************end
               backdata(packlen) = &H3
End Sub

Private Sub trans_data()

   MSComm1.Output = package

   Do
   DoEvents
   Loop Until MSComm1.OutBufferCount = 0
   
    tti = Now
      ttdelay = 0.5
      
    Do
       DoEvents
       tti1 = (Now - tti) * 24# * 60# * 60#
    Loop Until tti1 > ttdelay

End Sub

Private Sub retrans_data()

   MSComm1.Output = backdata

   Do
   DoEvents
   Loop Until MSComm1.OutBufferCount = 0
   
    tti = Now
      ttdelay = 1
      
    Do
       DoEvents
       tti1 = (Now - tti) * 24# * 60# * 60#
    Loop Until tti1 > ttdelay

End Sub

Function sum_p(p() As Byte, l) As Integer

   Dim sum1 As Single
   
      sum1 = 0#
        For i = 6 To l - 3
           sum1 = sum1 + p(i)
        Next i
        
      sum_p = Int(sum1)
      
End Function
Function str_hex(str1)
    bith8 = Left(str1, 1)
    bitl8 = Right(str1, 1)
    If Not IsNumeric(bith8) Then
        Data1 = Asc(UCase(bith8)) - Asc("A") + 10
    Else
        Data1 = Val(bith8)
    End If
    If Not IsNumeric(bitl8) Then
        Data2 = Asc(UCase(bitl8)) - Asc("A") + 10
    Else
        Data2 = Val(bitl8)
    End If
    str_hex = Data1 * 16 + Data2
End Function
Function char_hex(char1)
    If Not IsNumeric(char1) Then
        Data1 = Asc(UCase(char1)) - Asc("A") + 10
    Else
        Data1 = Val(char1)
    End If
    char_hex = Data1
End Function



'Private Sub combo_Click(Index As Integer)
'  If (Index = 0) Then
'    Select Case combo(Index).Index
'       Case 0
'          portnumber = 1
'       Case 1
'          portnumber = 2
'       Case 2
'          portnumber = 3
'       Case 3
'          portnumber = 4
'    End Select
'  End If
'End Sub

Private Sub command1_Click()
  Open App.Path + "\standard.cfg" For Input As #2
    
    For i = 1 To 5
            If Not EOF(1) Then
                Line Input #2, buff
                combo(i - 1).Text = buff
            End If
    Next i
    
    Close #2
End Sub

Private Sub command2_Click()

  Open App.Path + "\user.cfg" For Output As #3
    
    For i = 1 To 5
        Print #3, combo(i - 1).Text
    Next i
    
    Close #3
    
End Sub

Private Sub Command3_Click()
 WindowState = vbMinimized
End Sub

Private Sub Form_Load()
    code = 0
    chsum = 15
    portnumber = 1
    
    If WindowState = vbMinimized Then
        LastState = vbNormal
    Else
        LastState = WindowState
    End If
    Call AddToTray(Me, mnuTray)
    Call SetTrayTip("在线监测专用串口通讯工具")
    Me.Hide
    
    viewgrid.TextMatrix(1, 0) = "放电量"
    viewgrid.TextMatrix(2, 0) = "脉冲个数"
    viewgrid.TextMatrix(3, 0) = "故障状态"
    For i = 1 To 16
        viewgrid.TextMatrix(0, i) = "通道" + Str(i)
        viewgrid.ColAlignment(i) = 4
    Next i
    viewgrid.ColAlignment(0) = 4
    viewgrid.ColWidth(0) = 1500
    viewgrid.TextMatrix(0, 0) = "发送数据"

        MSComm1.CommPort = portnumber
        MSComm1.Settings = "9600,n,8,1"
        MSComm1.RThreshold = 1
        MSComm1.InBufferSize = 20
        MSComm1.OutBufferSize = 80
        MSComm1.InputLen = 1
        MSComm1.InputMode = comInputModeBinary
        MSComm1.InBufferCount = 0
        MSComm1.OutBufferCount = 0
    
    With combo(0)
       .AddItem "com1"
       .AddItem "com2"
       .AddItem "com3"
       .AddItem "com4"
    End With
    
    With combo(1)
       .AddItem 2400
       .AddItem 4800
       .AddItem 9600
       .AddItem 19200
    End With

    With combo(2)
       .AddItem 5
       .AddItem 6
       .AddItem 7
       .AddItem 8
    End With

    With combo(3)
       .AddItem 1
       .AddItem 1.5
       .AddItem 2
    End With
    
    With combo(4)
       .AddItem "偶"
       .AddItem "奇"
       .AddItem "无"
    End With
'*************************************************************************

  Open App.Path + "\user.cfg" For Input As #1
    
    For i = 1 To 5
            If Not EOF(1) Then
                Line Input #1, buff
                combo(i - 1).Text = buff
            End If
    Next i
    
    Close #1
    
'*************************************************************************
    For i = 1 To chsum
      trouble(i) = 1
      pcdata(i) = 2
      ndata(i) = 3
    Next i
'*************************************************************************

    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
    
 '************************************************************************
    
       rscount = 1
       
    Open App.Path + "\state.log" For Output As 1
       Write #1, 0
    Close 1
       
       
    Open App.Path + "\state.log" For Output As #1
        
Do
   
    ll = receive_data()
    yy = check_data(ll)
    processing (yy)
    
    If (code = 0) Then
         Text1.Text = Text1.Text + "通讯故障，请检测" + Chr(13) + Chr(10)
    End If
    
 
      tti = Now
      ttdelay = 2
      
    Do
       DoEvents
       tti1 = (Now - tti) * 24# * 60# * 60#
    Loop Until tti1 > ttdelay
    
'*************************************************************

       If (rscount < 50) Then
            Print #1, filestr
            rscount = rscount + 1
       Else
          rscount = 1
          Close 1
          
          Open App.Path + "\state.log" For Output As 1
              Write #1, 0
          Close 1

          Open App.Path + "\state.log" For Output As #1
              Print #1, filestr
              rscount = rscount + 1
       End If
    
        Text1.Text = ""
        
        For i1 = 1 To chsum
          viewgrid.TextMatrix(3, i1) = ""
          viewgrid.TextMatrix(1, i1) = ""
          viewgrid.TextMatrix(2, i1) = ""
        Next i1
        
        Text1.Text = Text1.Text + "检测缓冲区" + Chr(13) + Chr(10)
        
      tti0 = Now
      ttdelay0 = 0.1
      
    Do
       DoEvents
       tti2 = (Now - tti0) * 24# * 60# * 60#
    Loop Until tti1 > ttdelay0
Loop

End Sub

Private Sub qvalue(packtemp() As Byte, number As Integer, l As Integer)
      packtemp(number) = pcdata(l) Mod 256
      packtemp(number + 1) = Fix(pcdata(l) / 256)
End Sub

Private Sub Form_Resize()
    Select Case WindowState
        Case vbMinimized
            Me.Visible = False
            mnuTrayMinimize.Enabled = False
            mnuTrayRestore.Enabled = True
        Case vbMaximized
            Me.Visible = True
            mnuTrayMinimize.Enabled = True
            mnuTrayRestore.Enabled = True
        Case vbNormal
            Me.Visible = True
            mnuTrayMinimize.Enabled = True
            mnuTrayRestore.Enabled = False
    End Select
    If WindowState <> vbMinimized Then
        LastState = WindowState
        Me.Visible = True
    End If
End Sub

' Important! Remove the tray icon.
Private Sub Form_Unload(Cancel As Integer)
   If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    RemoveFromTray
    End
    
   Close #1
End Sub

Private Sub mnuAbout_Click()
  frmabout.Show vbModal
End Sub

Private Sub mnuTrayClose_Click()
    Unload Me
End Sub
Private Sub mnuTrayMinimize_Click()
    WindowState = vbMinimized
End Sub
Private Sub mnuTrayRestore_Click()
    SendMessage hwnd, WM_SYSCOMMAND, _
        SC_RESTORE, 0&
End Sub
Private Sub importdata()

 On Error GoTo errHandler
    Open "d:\Program Files\西安中亚实业有限公司\在线监测系统v2.6\临时文件\GY.DAT" For Input As #66
        For i = 1 To 15
            Line Input #66, pcdata(i)
            Line Input #66, ndata(i)
            Line Input #66, trouble(i)
        Next i
    Close #66
errHandler:
   Exit Sub
    
End Sub