communication.bas

基于RS－232的

        COMM_ReSendTimes = 0 '重传次数复位
        '若消息队列中仍有消息，则发送消息
        SED_ExtractRealData COMM_RcvData '取出数据
        COMM_CheckResumeSend
        'If COMM_IsMessageGroupEmpty = False Then COMM_CheckMessageAndPack
       
        
        'COMM_isSendOverFlag = True
       ' COMM_CurCmd = NO_CMD
        Put #1, , "FUN_comm_processrcvdata" & "ack_ok_updata_reset" & vbCr & vbLf
   ' Else '复位
   '     COMM_ReSendTimes = 0 '重传次数复位
       ' SED_ExtractRealData COMM_RcvData '取出数据
       ' COMM_isSendOverFlag = True
        '若消息队列中仍有消息，则发送消息
   '     COMM_CheckResumeSend
        'If COMM_IsMessageGroupEmpty = False Then COMM_CheckMessageAndPack
      
    End If 'end of process of all cmd
   Else ' CorrectFlag = ACK_FAIL Then '下位机接收不正确
  '重发，3次
   
    If COMM_ReSendTimes < 2 Then
      Put #1, , "FUN_comm_processrcvdata" & "ack_fail_resend_times-" & COMM_ReSendTimes & vbCr & vbLf
       COMM_ReSendTimes = COMM_ReSendTimes + 1 '起始值为0
       COMM_StartSendData '继续该命令的传送
    Else
      Put #1, , "FUN_comm_processrcvdata" & "ack_fail_resend_times >2 and_reset" & vbCr & vbLf
    '  COMM_isSendOverFlag = True
      COMM_ReSendTimes = 0 '重传 次数复位
     ' COMM_CurCmd = NO_CMD '重传，及命令复位
      COMM_CurHisPackIndex = 0 '?????
      '若消息队列中仍有消息，则发送消息
      COMM_CheckResumeSend
       'If COMM_IsMessageGroupEmpty = False Then COMM_CheckMessageAndPack
    End If
    
    
          
  End If ' end of ack-ok
  
  
  
Else '校验错误
Put #1, , "_FUN_comm_processrcvdata" & "crc_fail" & vbCr & vbLf
 '重发包，3次
   If COMM_ReSendTimes < 2 Then
       COMM_StartSendData '继续该命令的传送
       Put #1, , "FUN_comm_processrcvdata" & "crc_fail_resend_times-" & COMM_ReSendTimes & vbCr & vbLf
    Else
     '  COMM_isSendOverFlag = True
       COMM_ReSendTimes = 0
      ' COMM_CurCmd = NO_CMD ' 命令，及重发 复位
       COMM_CurHisPackIndex = 0
       '若消息队列中仍有消息，则发送消息
       COMM_CheckResumeSend
       'If COMM_IsMessageGroupEmpty = False Then COMM_CheckMessageAndPack
       
       Put #1, , "FUN_comm_processrcvdata" & "crc_fail_resend_times >2,and reset" & vbCr & vbLf
   End If
   COMM_ReSendTimes = COMM_ReSendTimes + 1 '起始值为0
 
End If


End Sub




Private Sub COMM_StartSendData()

zhandianpic_fashe '亮
Dim num As Double, I, K As Integer
 'num = UBound(COMM_SendPacket)
Put #1, , "start_fun_comm_startsendData:-" & vbCr & vbLf
Put #1, , ConvertChar(COMM_SendPacket) & vbCr & vbLf
 'COMM_isSendOverFlag = False
 COMM_isACKFlag = False '下位机应答初始化为无
 overtime_timer.interval = ACK_OVERTIME
 overtime_timer.Enabled = True
 If COMM_SendMSCOMM.PortOpen = True Then COMM_SendMSCOMM.Output = COMM_SendPacket  '发送数据

 'Do
  '  K = DoEvents()
' Loop Until COMM_SendMSCOMM.OutBufferCount = 0
 'Put #1, , COMM_SendPacket

End Sub
Public Sub COMM_Overtime_timer_timer()
Put #1, , "start_fun_overtime_timer_timer" & vbCr & vbLf
Put #1, , "start_fun_overtime_timer_timer-comm_isackflag:--" & COMM_isACKFlag & vbCr & vbLf
  If COMM_isACKFlag = False Then
    Dim tmp As Variant
    ReDim COMM_RcvData(0) '清空接收缓冲区
    tmp = COMM_RcVMSCOMM.InputLen
    COMM_RcVMSCOMM.InBufferCount = 0 '清空串口接收缓冲区
    RcvDataByteIndex = 0 '接收的字节数复位
    If COMM_ReSendTimes < 2 Then
      COMM_ReSendTimes = COMM_ReSendTimes + 1
      COMM_StartSendData
      Put #1, , "start_fun_overtime_timer_timer-resend:--" & COMM_ReSendTimes & vbCr & vbLf
    Else
      Put #1, , "start_fun_overtime_timer_timer-over" & vbCr & vbLf
    
       'If COMM_IsMessageGroupEmpty = False Then COMM_CheckMessageAndPack
       
     ' COMM_isSendOverFlag = True '复位发送完标志
      COMM_ReSendTimes = 0
      overtime_timer.Enabled = False
      COMM_CurHisPackIndex = 0 '历史包索引复位
      '若消息队列中仍有消息，则发送消息
      COMM_CheckResumeSend
    End If
  Else
    
  End If
End Sub


Public Sub COMM_End()
Put #1, , "start_fun_comm_end" & vbCr & vbLf
If COMM_RcVMSCOMM.PortOpen = True Then COMM_RcVMSCOMM.PortOpen = False
If COMM_SendMSCOMM.PortOpen = True Then COMM_SendMSCOMM.PortOpen = False
End Sub
Public Function ConvertChar(dat() As Byte) As String
Dim I As Integer, str As String
str = " "
 For I = 0 To UBound(dat)
  str = str & (Hex(dat(I)))
 Next I
 ConvertChar = str
End Function
Private Sub sleep(I As Double, waitFlag As Boolean)
Dim K As Double, t As Double, R As Double, fir As Double
t = 0
For fir = 0 To I Step 1
For K = 0 To I Step 1
If waitFlag = True Then Exit Sub
t = t + 1
DoEvents
Next K
t = 0
Next fir
End Sub


'Public Sub checkSendAvilabeFlag_timer()
  
'End Sub

Public Sub COMM_CheckResumeSend()
Dim flag As Boolean, I As Integer
Dim count As Integer
count = UBound(COMM_CMDGroup)
If count <> 0 Then '有消息
  
   If COMM_CMDGroup(1).BeenUsedFlag = True Then
     
   '若命令已经用过，则从消息队列中删去
      For I = 1 To count - 1
       COMM_CMDGroup(I) = COMM_CMDGroup(I + 1)
      Next I
     ReDim Preserve COMM_CMDGroup(count - 1)
   End If
End If

count = UBound(COMM_CMDGroup)

'flag = COMM_IsMessageGroupEmpty

If count > 0 Then
  COMM_CheckMessageAndPack
Else
  MainForm1.CheckUI_IOKey.Caption = "检测"
  COMM_TerminateSendByForce = False
  MainForm1.CheckUI_IOKey.Enabled = True
  MainForm1.Enable_CheckMethod
  MainForm1.cmdPic = " " '图片中发送命令标志空
'  MainForm1.selectstioCombo.Text = 1
'  MainForm1.DisplayStioName.Text = StioName(1)
End If

End Sub

Public Sub COMM_AddCMd(cmd As Byte, station As Integer)
Dim count As Integer '添加消息队列
Dim I As Integer

count = UBound(COMM_CMDGroup)


ReDim Preserve COMM_CMDGroup(count + 1)
COMM_CMDGroup(count + 1).cmd = cmd
COMM_CMDGroup(count + 1).station = station
COMM_CMDGroup(count + 1).BeenUsedFlag = False
'若当前无命令发送，则发送新命令

count = UBound(COMM_CMDGroup)
Put #1, , "FUN_comm_addcmd: cmd: " & Hex(cmd) & " and station:= " & station & vbCr & vbLf
If count > 1 Then
   For I = 1 To count
   Put #1, , "FUN_comm_addcmd:per  cmd: " & Hex(COMM_CMDGroup(I).cmd) & " and station:= " & COMM_CMDGroup(I).station & "--Boolean:=" & COMM_CMDGroup(I).BeenUsedFlag & "---" & I & vbCr & vbLf
   Next I
End If

If COMM_CMDGroup(1).BeenUsedFlag = False Then COMM_CheckMessageAndPack

End Sub
Private Sub COMM_CheckMessageAndPack() 'outPackData() As Byte)
Dim count As Integer, cmd As Byte, station As Integer, dat() As Byte
Dim I, J As Integer
count = UBound(COMM_CMDGroup)

'If count <> 0 Then '有消息
  
 '  If COMM_CMDGroup(1).BeenUsedFlag = True Then
   '若命令已经用过，则从消息队列中删去
  '    For I = 1 To count - 1
  '     COMM_CMDGroup(I) = COMM_CMDGroup(I + 1)
  '    Next I
  '   ReDim Preserve COMM_CMDGroup(count - 1)
  ' End If
'End If
' count = UBound(COMM_CMDGroup)
 If count <> 0 And COMM_CMDGroup(1).BeenUsedFlag = False Then '有消息
    cmd = COMM_CMDGroup(1).cmd: station = COMM_CMDGroup(1).station
    COMM_CMDGroup(1).BeenUsedFlag = True
    
    Dim cmdstr As String
    Static num As Integer
   
   Select Case cmd
    Case UP_UI: cmdstr = "采集电压电流，状态信息": num = 0
    Case UP_TIME: cmdstr = "上传时间": num = 0
    Case UP_HISRECORD: cmdstr = "上传历史记录": num = 0
    Case DOWN_STDTIME: cmdstr = "下传标准时间"
                       If num = 0 Then SED_SetPCSysTime    '设置系统时间
                       num = num + 1
    Case DOWN_IO: cmdstr = "控制开关灯": num = 0
    Case DOWN_OCTIME: cmdstr = "下传开关灯时间": num = 0
   End Select
    
   '///////////
   '站点，图片显示
   '发送CAN 总线命令时，地址为10号机
     If station > 0 And station <= StioNum Then
      MainForm1.selectstioCombo.Text = station
      MainForm1.DisplayStioName.Text = StioName(station)
      '站点画面更新
     ' If MainForm1.selectcheckmode(0).Value = False Then
        MainForm1.stationPic.Caption = StioName(station)
        MainForm1.cmdPic.Caption = cmdstr
        module2_ChangeStationPic station
      'endif
     ElseIf station = 50 Then 'CAN地址 50号端口
      MainForm1.selectstioCombo.Text = 1
      MainForm1.DisplayStioName.Text = StioName(1)
      module2_ChangeStationPic 1
      MainForm1.stationPic.Caption = StioName(1)
      MainForm1.cmdPic.Caption = "修改波特率 "
    End If
   '/'''''''''''
    
     
     Put #1, , "FUN_comm_checkmessageandpack: cmd: " & Hex(cmd) & " and station:= " & station & vbCr & vbLf
   
     SED_GetDataFromDataBase station, cmd, dat
     
     COMM_CurDestADDR = COMM_MachineADDR(station - 1)
       
     COMM_PacketData cmd, COMM_CurDestADDR, dat, COMM_SendPacket
  
     COMM_StartSendData
     
  End If

End Sub
Public Sub COMM_DelCMD(cmd As Byte, station As Integer)
'删除命令，从而中断发送
  Dim count, K As Integer, Pos As Integer
  Pos = 0
  count = UBound(COMM_CMDGroup)
  For K = 1 To count
   If COMM_CMDGroup(K).cmd = cmd And COMM_CMDGroup(K).station = station Then Pos = K: Exit For
  Next K
  If Pos <> 0 Then
  Put #1, , "FUN_comm_delcmd: cmd: " & Hex(cmd) & " and station:= " & station & vbCr & vbLf
    For K = Pos To count - 1
     COMM_CMDGroup(K) = COMM_CMDGroup(K + 1)
    Next K
    ReDim Preserve COMM_CMDGroup(count - 1)
  End If
  
  
End Sub
Public Function COMM_IsMessageGroupEmpty() As Boolean
Dim count As Integer

count = UBound(COMM_CMDGroup)

If count = 0 Then
  COMM_IsMessageGroupEmpty = True
'ElseIf count = 1 And COMM_CMDGroup(1).BeenUsedFlag = True Then
'  ReDim Preserve COMM_CMDGroup(0)
'  COMM_IsMessageGroupEmpty = True
Else
  COMM_IsMessageGroupEmpty = False
End If
End Function
Public Sub COMM_GetCurProcessCMd(out_cmd As Integer, out_station As Integer)
Dim count As Integer
count = UBound(COMM_CMDGroup)
If count = 0 Then
   out_cmd = 0: out_station = 0
Else
   out_cmd = COMM_CMDGroup(1).cmd: out_station = COMM_CMDGroup(1).station
End If
 
End Sub