communication.bas

基于RS－232的

'If indexE = iend Then indexE = indexE - 1
If indexS < istart Then indexS = istart

K = indexS
For I = indexS To indexE
  dataArray(K) = dataArray(I)
  If dataArray(I) = &H7D& And I < indexE Then
     If dataArray(I + 1) = &H5E& Then
        dataArray(K) = &H7E&
        I = I + 1
     ElseIf dataArray(I + 1) = &H5D& Then
        dataArray(K) = &H7D&
        I = I + 1
     ElseIf dataArray(I + 1) = &H5F& Then
        dataArray(K) = &HFF&
        I = I + 1
     End If

  End If
  K = K + 1
Next I
RcvDataByteIndex = K - 1
Exit Sub




'Put #1, , "start_FUN_comm_del7dflag" & vbCr & vbLf
K = istart
For I = istart To iend
  dataArray(K) = dataArray(I)
  If dataArray(I) = &H7D& Then
     If dataArray(I + 1) = &H5E& Then
        dataArray(K) = &H7E&
        I = I + 1
     ElseIf dataArray(I + 1) = &H5D& Then
        dataArray(K) = &H7D&
        I = I + 1
     ElseIf dataArray(I + 1) = &H5F& Then
        dataArray(K) = &H7F&
        I = I + 1
     End If

  End If
  K = K + 1
Next I
RcvDataByteIndex = K - 1
Exit Sub
'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) = &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
   '////7d-5F----FF
 ElseIf dataArray(indexS) = &H7D& And dataArray(indexS + 1) = &H5F& Then
   dataArray(indexS) = &HFF&
   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


Private Function COMM_GenerateCRC(data() As Byte, indexS As Integer, indexE As Integer) As Byte
    '//求异或
   ' BYTE tmp=0;
   ' for(int i=0;i<len;i++)
   ' {
   '     tmp=tmp+data[i];
   ' }
   ' return ((0xFF^tmp)+1);
  
   
   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
   'length = UBound(data)
   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
   'zerobyte - tmp
   'Put #1, , "FUN_comm_generatecrc: " & (COMM_GenerateCRC) & vbCr & vbLf
    
End Function
Private Function COMM_CheckCRC(data() As Byte) As Byte
'BYTE tmp=0;
 '   for(int i=0;i<Len;i++)
 '   {
 '       tmp=tmp+pdata[i];
 '   }
 '   return tmp;=0 校验正确
 Dim tmp As Integer, I As Integer
 tmp = 0
 For I = 0 To RcvDataByteIndex 'UBound(data) Step 1
  tmp = (tmp + data(I)) And 255
 Next I
 COMM_CheckCRC = tmp
' Put #1, , "FUN_comm_checkcrc: " & (COMM_CheckCRC) & vbCr & vbLf
End Function

Public Sub COMM_MSCommCtl_OnComm(RcvLed As Object)
'Put #1, , "FUN_mscommctl_oncomm" & vbCr & vbLf
Select Case COMM_RcVMSCOMM.CommEvent
  
  Case comEvReceive
       MainForm1.RcvLedTimer.Enabled = False
       zhandianpic_receive '控制绿灯
     '  RcvLed.RxdOnOff = 1 '0 '接收灯亮
       Call COMM_ReceiveData
  'Case comEvEOF '接收灯灭？？？？？？？？是否为接收结束标志
    '   RcvLed.RxdOnOff = 0
End Select
End Sub
Private Sub COMM_ReceiveData()

Dim di As Variant
Dim cLen, I, num As Integer
'Put #1, , "start_FUN_comm_receivedata" & vbCr & vbLf

'Put #1, , "in_FUN_comm_receivedata_ overtime-timer is unenable:" & vbCr & vbLf
cLen = COMM_RcVMSCOMM.InBufferCount
' Put #1, , "time:" & Time & "--in_FUN_comm_receivedata_orgdata number:" & cLen & vbCr & vbLf
di = COMM_RcVMSCOMM.Input

Dim tmp() As Byte
ReDim tmp(0 To cLen - 1)
For I = 0 To cLen - 1
tmp(I) = di(I)
Next I

'  Put #1, , "in_FUN_comm_receivedata_orgdata:" & ConvertChar(tmp) & vbCr & vbLf
  Erase tmp
  
 'For I = 0 To cLen + num - 2
 'index = 0
 If COMM_PKStartFlag = False And COMM_PKEndFlag = False Then
     RcvDataByteIndex = 0 '接收字节索引号
     'COMM_RcvData(0) = 0
     tmp_Rcvdata(0) = 0
  End If
 For I = 0 To cLen - 1
   If COMM_PKStartFlag = False Then
      If di(I) = PKStart Then
         'COMM_RcvData(0) = di(I)
       '  ReDim COMM_RcvData(400)
         COMM_PKStartFlag = True
      End If
   Else
      If RcvDataByteIndex = 0 Then
         If di(I) <> PKStart Then
           'COMM_RcvData(0) = di(I)
            tmp_Rcvdata(0) = di(I)
           RcvDataByteIndex = RcvDataByteIndex + 1
         End If
      Else
         If di(I) <> PKEND Then
           'COMM_RcvData(RcvDataByteIndex) = di(I)
            tmp_Rcvdata(RcvDataByteIndex) = di(I)
           If RcvDataByteIndex = 400 Then
             COMM_PKEndFlag = True
             Exit For
           End If
           
           RcvDataByteIndex = RcvDataByteIndex + 1
           
           
         Else
           COMM_PKEndFlag = True
           RcvDataByteIndex = RcvDataByteIndex - 1
           Exit For
         End If
      End If
   End If
   
 Next I
 GoTo backstep
 
 Do Until COMM_PKEndFlag = True Or I > cLen - 1
    
  If di(I) = PKStart And RcvDataByteIndex = 0 Then
        ReDim COMM_RcvData(400)
        COMM_RcvData(0) = PKStart
  ElseIf di(I) <> PKStart And COMM_RcvData(0) = PKStart Then
       'ReDim COMM_RcvData(200)
       RcvDataByteIndex = 0
       COMM_PKStartFlag = True
       COMM_RcvData(RcvDataByteIndex) = di(I)
  ElseIf di(I) = PKEND And COMM_RcvData(RcvDataByteIndex) <> PKEND Then
       COMM_PKEndFlag = True
            
  ElseIf COMM_PKStartFlag = True And COMM_PKEndFlag = False Then
       
       RcvDataByteIndex = RcvDataByteIndex + 1
       'ReDim Preserve COMM_RcvData(RcvDataByteIndex)
       COMM_RcvData(RcvDataByteIndex) = di(I)
  End If
  I = I + 1
Loop
backstep:
If COMM_PKEndFlag = True Then
   COMM_isACKFlag = True
   overtime_timer.Enabled = False '超时无效
   COMM_PKStartFlag = False
   COMM_PKEndFlag = False
   ReDim COMM_RcvData(RcvDataByteIndex)
   For I = 0 To RcvDataByteIndex
   COMM_RcvData(I) = tmp_Rcvdata(I)
   Next I
   Put #1, , "in_FUN_comm_receivedata_comm_realdata:" & ConvertChar(COMM_RcvData) & "(" & RcvDataByteIndex & ")" & vbCr & vbLf
   If RcvDataByteIndex > 2 Then ProcessRcvData
   RcvDataByteIndex = 0
 End If


End Sub


Private Sub ProcessRcvData()
Dim CRC As Byte, num, I As Integer
'Put #1, , "start_FUN_comm_processrcvdata" & vbCr & vbLf



COMM_Del7DFlag COMM_RcvData, UBound(COMM_RcvData) - 1, UBound(COMM_RcvData)  '过滤校验位的特殊字符
ReDim Preserve COMM_RcvData(RcvDataByteIndex)
CRC = COMM_CheckCRC(COMM_RcvData)

If CRC = 0 Then '校验正确
 Put #1, , "start_FUN_comm_processrcvdata" & "crc_ok" & vbCr & vbLf
  COMM_Del7DFlag COMM_RcvData, 0, UBound(COMM_RcvData) '过滤数据中的特殊字符
  ReDim Preserve COMM_RcvData(RcvDataByteIndex - 1) '需去掉校验位
  Dim sourceADDR As Byte, CorrectFlag As Byte
  sourceADDR = COMM_RcvData(1) '下位机地址
  CorrectFlag = COMM_RcvData(2) '标志位，01正确，02错误
  
  If CorrectFlag = ACK_OK Then '下位机正确接收
    '下位机无上传数据
     If COMM_CurCmd = DOWN_IO Or COMM_CurCmd = DOWN_OCTIME Or COMM_CurCmd = DOWN_STDTIME Then
       
       Put #1, , "FUN_comm_processrcvdata" & "ack_ok_UP_no _data" & vbCr & vbLf
      
       COMM_ReSendTimes = 0 '重传次数复位
       'COMM_isSendOverFlag = True
      ' COMM_CurCmd = NO_CMD
       '若消息队列中仍有消息，则发送消息
       COMM_CheckResumeSend
       'If COMM_IsMessageGroupEmpty = False Then COMM_CheckMessageAndPack
       Put #1, , "FUN_comm_processrcvdata" & "ack_ok_up_nodata_reset" & vbCr & vbLf
       
     ElseIf COMM_CurCmd = UP_HISRECORD Then '下位机有上传数据历史记录
       COMM_ReSendTimes = 0 '重传次数复位
       Dim CurRcvPacketIndex As Double, t1 As Double, t2 As Double
       t1 = COMM_RcvData(4): t2 = COMM_RcvData(5)
       CurRcvPacketIndex = t1 * 256 + t2
       If CurRcvPacketIndex > 99 Then
       Dim avg As Integer
       avg = 3
       End If
      
       Put #1, , "FUN_comm_processrcvdata" & "rcv_UpHistory_packnum:" & CurRcvPacketIndex & vbCr & vbLf
       Put #1, , "FUN_comm_processrcvdata" & "send_ack_ok_UpHistory_packnum:" & COMM_CurHisPackIndex & vbCr & vbLf
       COMM_CurHisPackIndex = COMM_CurHisPackIndex + 1
       'If COMM_CurHisPackIndex < HISPACKETNUM And COMM_TerminateSendByForce = False Then
       If CurRcvPacketIndex <> &HFFFF& And COMM_TerminateSendByForce = False Then
         Dim dat() As Byte
         '要求发送其他包
         
         COMM_PacketData UP_HISRECORD, COMM_CurDestADDR, dat, COMM_SendPacket
         COMM_StartSendData

       Else
       '先清零再组包
         COMM_CurHisPackIndex = 0
       '若消息队列中仍有消息，则发送消息
         COMM_CheckResumeSend
        
         Put #1, , "FUN_comm_processrcvdata" & "ack_ok_uphis_reset" & vbCr & vbLf
       ' COMM_isSendOverFlag = True
        
        ' COMM_CurCmd = NO_CMD '发送结束
       End If 'end of send history
      
       SED_ExtractRealData COMM_RcvData '取出数据
       
    ElseIf COMM_CurCmd = UP_UI Or COMM_CurCmd = UP_TIME Then '下位机上传得其它数据UI，IO，TIME
        Put #1, , "FUN_comm_processrcvdata" & "ack_ok_up_data to extract:" & ConvertChar(COMM_RcvData) & vbCr & vbLf