module1.bas

频率自动测量系统是一个用于测量电子元件的软硬件综合系统。本系统由几个部分组成

Attribute VB_Name = "Module1"
'目标地址
Public Const T_ADDR1 As Byte = &H31&
Public Const T_ADDR2 As Byte = &H32&
Public Const T_ADDR3 As Byte = &H33&
Public Const T_ADDR4 As Byte = &H34&
Public Const T_ADDR5 As Byte = &H35&
Public Const T_ADDR6 As Byte = &H36&
Public Const T_ADDR7 As Byte = &H37&
Public Const T_ADDR8 As Byte = &H38&
Public Const T_ADDR9 As Byte = &H39&
Public Const T_ADDR10 As Byte = &H3A&
Public Const T_ADDR11 As Byte = &H3B&
Public Const T_ADDR12 As Byte = &H3C&
Public Const T_ADDR13 As Byte = &H3D&
Public Const T_ADDR14 As Byte = &H3E&
Public Const T_ADDR15 As Byte = &H3F&
Public Const T_ADDR16 As Byte = &H40&
Public Const T_ADDR17 As Byte = &H41&
Public Const T_ADDR18 As Byte = &H42&
Public Const T_ADDR19 As Byte = &H43&
Public Const T_ADDR20 As Byte = &H44&

Public Const PC_ADDR0 As Byte = &H11& 'PC机A
Public Const PC_ADDR1 As Byte = &H12& 'PC机B

Public Const Power_ADDR As Byte = &H16& '电源监控设备地址

Public BITRATE As Variant
'包头
Public Const PKStart As Byte = &H7E&
Public Const PKEND As Byte = &H7E&

'下位机应答量
Public Const ACK_OK As Byte = &H1&
Public Const ACK_FAIL As Byte = &H2&
Public Const ACK_OVERTIME As Integer = 100 '超时时间1秒

'当前发送的命令
Public COMM_CurCmd As Byte
Public Const ControlCmd As Byte = &H2&
Public Const PowerOn As Byte = &H51&
Public Const PowerOff As Byte = &H52&
Public Const rvCmd_True As Byte = &H1&
Public Const rvCmd_False As Byte = &H2&

'包头包尾判别标志
Public COMM_PKStartFlag As Boolean, COMM_PKEndFlag As Boolean

'收到包的个数
Public COMM_RcvDataNum As Integer, RcvData() As Byte

Public COMM_SendPacket() As Byte '当前发送的包
Public COMM_ReSendTimes As Integer '记录重传次数
Public COMM_isSendOverFlag As Boolean '发送是否结束
Public COMM_isACKFlag As Boolean '检测是否有应答
Private overtime_timer As Timer '超时时钟
Private COMM_RcVMSCOMM As MSComm, COMM_SendMSCOMM As MSComm '使用的发送控件
Public Const HISPACKETNUM As Integer = 3 '历史包的总包数
Public COMM_CurHisPackIndex As Integer   '当前发送的历史包序列号
Public COMM_CurDestADDR As Byte  '当前访问下位机的地址
Private RcvDataByteIndex As Integer '接收字节的索引号


Public Sub COMM_PacketData_On(cmd As Byte, ADDR As Byte, Data() As Byte, senddata() As Byte)

 'cmd  为下传命令

 'addr 为下传的地址

 'data 为需下传的原始数据

 'senddata 为打包好的数据

 


Dim start As String

Dim ub, lb, num As Integer

ReDim senddata(6) As Byte

      senddata(0) = PKStart

      senddata(1) = Power_ADDR

      senddata(2) = PC_ADDR0

      senddata(3) = 0

      senddata(4) = ControlCmd

      senddata(5) = cmd
      
      senddata(6) = PowerOn

      COMM_CurCmd = cmd '当前包类型

      ReDim Preserve senddata(0 To 8) As Byte

      COMM_Add7DFlag senddata, 1, 4 ' 1-4之间数据寻找7D7E7F做转换（除去包头）

      

      ub = UBound(senddata)

      senddata(ub - 1) = COMM_GenerateCRC(senddata, 1, ub - 2)

      senddata(ub) = PKEND

      COMM_Add7DFlag senddata, ub - 1, ub - 1

   End Sub
   Public Sub COMM_PacketData_Off(cmd As Byte, ADDR As Byte, Data() As Byte, senddata() As Byte)

 'cmd  为下传命令

 'addr 为下传的地址

 'data 为需下传的原始数据

 'senddata 为打包好的数据

 


Dim start As String

Dim ub, lb, num As Integer

ReDim senddata(6) As Byte

      senddata(0) = PKStart

      senddata(1) = Power_ADDR

      senddata(2) = PC_ADDR0

      senddata(3) = 0

      senddata(4) = ControlCmd

      senddata(5) = cmd
      
      senddata(6) = PowerOff
      
      COMM_CurCmd = cmd '当前包类型

      ReDim Preserve senddata(0 To 8) As Byte

      COMM_Add7DFlag senddata, 1, 4 ' 1-4之间数据寻找7D7E7F做转换（除去包头）

      

      ub = UBound(senddata)

      senddata(ub - 1) = COMM_GenerateCRC(senddata, 1, ub - 2)

      senddata(ub) = PKEND

      COMM_Add7DFlag senddata, ub - 1, ub - 1

   End Sub
Public Sub COMM_Init(ovtime As Timer, rcvComm As MSComm, sendComm As MSComm)


'包头包尾标志，接收包时对完整包进行判别
COMM_PKStartFlag = False
COMM_PKEndFlag = False
'接收属于包内数据的个数，即RCVDATA的个数
COMM_RcvDataNum = 0
COMM_ReSendTimes = 0 '重传次数尾0
COMM_isACKFlag = False '下位机是否应答标志
'超时时钟间隔
Set overtime_timer = ovtime
overtime_timer.Interval = ACK_OVERTIME
overtime_timer.Enabled = False
RcvDataByteIndex = 0 '接收字节索引号
'发送及接收通信串口
Set COMM_RcVMSCOMM = rcvComm
Set COMM_SendMSCOMM = sendComm
COMM_isSendOverFlag = True

COMM_CurHisPackIndex = 0 '上传历史包号
BITRATE = Array(0, 1, 2, 3, 4, 5, 6, 7)
'Open logfileName For Binary As #1

End Sub
Private Function COMM_GenerateCRC(Data() As Byte, indexS As Integer, indexE As Integer) As Byte
Dim tmp As Integer, I As Integer, length As Integer, zerobyte As Byte
   Dim i1 As Integer, i2 As Integer, i3 As Integer
   zerobyte = 0
   tmp = 0
   For I = indexS To indexE Step 1
   tmp = (tmp + Data(I)) And 255
   Next I
   i1 = zerobyte
   i2 = tmp
   COMM_GenerateCRC = (0 - i2) And 255

    
End Function


Private Function COMM_CheckCRC(Data() As Byte) As Byte
 Dim tmp As Integer, I As Integer
 tmp = 0
 For I = 0 To UBound(Data) Step 1
  tmp = (tmp + Data(I)) And 255
 Next I
 COMM_CheckCRC = tmp
 'Put #1, , "FUN_comm_checkcrc: " & (COMM_CheckCRC) & Chr(13)
End Function
Private Sub COMM_Add7DFlag(dataArray() As Byte, indexS As Integer, indexE As Integer)

'index表明从dataarray数组的第及位开始查找

Dim istart, iend As Integer, I, k As Integer

istart = LBound(dataArray)

iend = UBound(dataArray)






For k = indexS To indexE Step 1  '排除包头和包尾

 If dataArray(indexS) = &H7E& Then

   iend = iend + 1

   ReDim Preserve dataArray(istart To iend) As Byte

   For I = iend To indexS + 2 Step -1

     dataArray(I) = dataArray(I - 1)

   Next I

     dataArray(indexS) = &H7D&

     dataArray(indexS + 1) = &H5E&

     indexS = indexS + 2

     

 ElseIf dataArray(indexS) = &H7D& Then

   iend = iend + 1

   ReDim Preserve dataArray(istart To iend) As Byte

   For I = iend To indexS + 2 Step -1

     dataArray(I) = dataArray(I - 1)

   Next I

     dataArray(indexS) = &H7D&

     dataArray(indexS + 1) = &H5D&

     indexS = indexS + 2


 ElseIf dataArray(indexS) = &H7F& Then

   iend = iend + 1

   ReDim Preserve dataArray(istart To iend) As Byte

   For I = iend To indexS + 2 Step -1

     dataArray(I) = dataArray(I - 1)

   Next I

     dataArray(indexS) = &H7D&

     dataArray(indexS + 1) = &H5F&

     indexS = indexS + 2
     

 Else

     indexS = indexS + 1

 End If

 

 Next k

End Sub

Private Sub COMM_Del7DFlag(dataArray() As Byte, indexS As Integer, indexE As Integer)

'index表明从dataarray数组的第及位开始查找

Dim istart, iend As Integer, I, k, num As Integer

istart = LBound(dataArray)

iend = UBound(dataArray)



'Put #1, , "start_FUN_comm_del7dflag" & Chr(13)

'For K = indexS To indexE Step 1

If indexE = iend Then indexE = indexE - 1

If indexS = iend Then indexS = indexS - 1



num = indexE - indexS

k = istart

Do Until num < 0

 If dataArray(indexS) = &H7D& And dataArray(indexS + 1) = &H5F& Then

   dataArray(indexS) = &H7F&

   For I = indexS + 1 To iend - 1 Step 1

     dataArray(I) = dataArray(I + 1)

   Next I

   iend = iend - 1

   ReDim Preserve dataArray(istart To iend) As Byte

   indexS = indexS + 1

    num = num - 2

 ElseIf dataArray(indexS) = &H7D& And dataArray(indexS + 1) = &H5E& Then

   dataArray(indexS) = &H7E&

   For I = indexS + 1 To iend - 1 Step 1

     dataArray(I) = dataArray(I + 1)

   Next I

   iend = iend - 1

   ReDim Preserve dataArray(istart To iend) As Byte
  indexS = indexS + 1
     num = num - 2
ElseIf dataArray(indexS) = &H7D& And dataArray(indexS + 1) = &H5D& Then
   dataArray(indexS) = &H7D&
   For I = indexS + 1 To iend - 1 Step 1
     dataArray(I) = dataArray(I + 1)
   Next I
   iend = iend - 1
   ReDim Preserve dataArray(istart To iend) As Byte
     indexS = indexS + 1

     num = num - 2

 Else

     indexS = indexS + 1

     num = num - 1

 End If

 Loop

 

End Sub

Public Sub COMM_StartSendData()

Dim num, I, k As Integer

 num = UBound(COMM_SendPacket)


 COMM_isSendOverFlag = False

 COMM_isACKFlag = False '下位机应答初始化为无

 overtime_timer.Interval = ACK_OVERTIME

 overtime_timer.Enabled = True

 COMM_SendMSCOMM.Output = COMM_SendPacket '发送数据

 Form1.Text1.Text = ConvertChar(COMM_SendPacket)

 Do

    k = DoEvents()

 Loop Until COMM_SendMSCOMM.OutBufferCount = 0