Attribute VB_Name = "communication"
Option Explicit
'命令種類
Public Const NO_CMD As Byte = 0
Public Const UP_UI As Byte = &H11&
Public Const DOWN_IO As Byte = &H12&
Public Const DOWN_OCTIME As Byte = &H13&
Public Const DOWN_STDTIME As Byte = &H14&
Public Const UP_HISRECORD As Byte = &H15&
Public Const UP_TIME As Byte = &H16&
Public Const DOWN_CANBITRATE As Byte = &H17& '下傳CAN總線波特率
'目標地址
Private Const T_ADDR1 As Byte = &H1&  '1號站點
Private Const T_ADDR2 As Byte = &H2&
Private Const T_ADDR3 As Byte = &H3&
Private Const T_ADDR4 As Byte = &H4&
Private Const T_ADDR5 As Byte = &H5&
Private Const T_ADDR6 As Byte = &H6&
Private Const T_ADDR7 As Byte = &H7&

Private Const PC_ADDR1 As Byte = &H8& 'PC機A
Private Const PC_ADDR2 As Byte = &H9& 'PC機B
Private Const CAN_ADDR As Byte = &HFE&  'can總線網絡地址
'目標地址數組
Public COMM_MachineADDR(50) As Byte
'設置CAN總線的波特率
'10K,20K,40K,50K,80K,100K,125K,200k 對應0－7
'Public COMM_BITRATE As Variant
Public COMM_TerminateSendByForce As Boolean '強行中斷傳輸標志，用于傳送歷史數據時
'包頭
Private Const PKStart As Byte = &H7E&
Private Const PKEND As Byte = &H7E&
'下位機應答量
Private Const ACK_OK As Byte = &H1&
Private Const ACK_FAIL As Byte = &H2&
Private Const ACK_OVERTIME As Integer = 500 '超時時間1秒
'當前發送的命令
Private COMM_CurCmd As Byte
'當前發送包的索引號
'Public COMM_CurPacketIndex As Integer
'打包要傳送的數據
'包頭包尾判別標志
Private COMM_PKStartFlag As Boolean, COMM_PKEndFlag As Boolean
'收到包的個數
Private COMM_RcvDataNum As Integer, COMM_RcvData() As Byte, tmp_Rcvdata() As Byte
'Public Type SENDPACKETTYPE '發送數據時可連續打幾個包
'  Dim data() As Byte
'  Dim isSendOverFlag As Boolean
'End Type
Private COMM_SendPacket() As Byte '當前發送的包
Private COMM_ReSendTimes As Integer '記錄重傳次數
Public COMM_isSendOverFlag As Boolean   '發送是否結束
Private COMM_isACKFlag As Boolean '檢測是否有應答
Private overtime_timer As Timer '超時時鐘
Private COMM_RcVMSCOMM As MSComm, COMM_SendMSCOMM As MSComm
Private Const HISPACKETNUM As Integer = 100 '歷史包的總包數(待定)
Private COMM_CurHisPackIndex As Integer   '當前發送的歷史包序列號
Private COMM_CurDestADDR As Byte  '當前訪問下位機的地址
Private Const logfileName = "d:\testcom.log" '日志文件
'Private DataBaseObj As Database '用于訪問數據及設置參數的數據庫對象
'Private tmpdata() As Byte
Private RcvDataByteIndex As Integer '接收字節的索引號
Private WaitSendFlagNum As Double '等待發送標志計數
Private MyMachineAdd As Byte
'Private waitSendFlagTimer As Timer
Type COMM_CmdMessageType
 cmd As Byte
 station As Integer
 BeenUsedFlag As Boolean
End Type

Private COMM_CMDGroup() As COMM_CmdMessageType  '消息隊列

Public Sub COMM_Init(ovtime As Timer, rcvComm As MSComm, sendComm As MSComm, MyAdd As Byte)  ', dbobj As Database)

If MyAdd = 1 Then
  MyMachineAdd = PC_ADDR1 'A本機地址
ElseIf MyAdd = 2 Then
  MyMachineAdd = PC_ADDR2 'B本機地址
End If

'包頭包尾標志，接收包時對完整包進行判別
COMM_PKStartFlag = False
COMM_PKEndFlag = False
'接收屬于包內數據的個數，即COMM_RCVDATA的個數
COMM_RcvDataNum = 0
COMM_ReSendTimes = 0 '重傳次數尾0
COMM_isACKFlag = False '下位機是否應答標志
'超時時鐘間隔
COMM_TerminateSendByForce = False '強行中斷發送命令
Set overtime_timer = ovtime
overtime_timer.interval = ACK_OVERTIME
overtime_timer.Enabled = False
RcvDataByteIndex = 0 '接收字節索引號
'發送及接收通信串口
ReDim COMM_RcvData(400): ReDim tmp_Rcvdata(400)
Set COMM_RcVMSCOMM = rcvComm
Set COMM_SendMSCOMM = sendComm

'Set waitSendFlagTimer = checkSendflagtime
'Set DataBaseObj = dbobj
'初始化發送和接收串口設置
 Dim recordDb As Recordset
 On Error Resume Next
 Set recordDb = db.OpenRecordset("文件路徑")
COMM_RcVMSCOMM.Settings = "19200,n,8,1"
 'COMM_RcVMSCOMM.Settings = "9600,n,8,1"
 COMM_RcVMSCOMM.commport = recordDb.Fields("通信端口").Value
 COMM_RcVMSCOMM.InBufferCount = 0                         ' 清接收緩沖區
 COMM_RcVMSCOMM.RThreshold = 1                            ' 接收數據長度
 COMM_RcVMSCOMM.OutBufferCount = 0
 COMM_RcVMSCOMM.InputMode = comInputModeBinary
 If COMM_RcVMSCOMM.PortOpen = False Then
 COMM_RcVMSCOMM.PortOpen = True
 End If
 Set COMM_SendMSCOMM = COMM_RcVMSCOMM
 'COMM_SendMSCOMM.Settings = "9600,n,8,1"
 'COMM_SendMSCOMM.commport = recordDB.Fields("通信端口").Value
 'COMM_SendMSCOMM.InBufferCount = 0                         ' 清接收緩沖區
 'COMM_SendMSCOMM.RThreshold = 1                            ' 接收數據長度
 'COMM_SendMSCOMM.OutBufferCount = 0
 'COMM_SendMSCOMM.InputMode = comInputModeBinary
 'If COMM_SendMSCOMM.PortOpen = False Then
 'COMM_SendMSCOMM.PortOpen = True
 'End If
 recordDb.Close
 Set recordDb = Nothing
COMM_isSendOverFlag = True

COMM_CurHisPackIndex = 0 '上傳歷史包號
'COMM_BITRATE = Array(0, 1, 2, 3, 4, 5, 6, 7)

'可訪問各機地址
COMM_MachineADDR(0) = T_ADDR1
COMM_MachineADDR(1) = T_ADDR2
COMM_MachineADDR(2) = T_ADDR3
COMM_MachineADDR(3) = T_ADDR4
COMM_MachineADDR(4) = T_ADDR5
COMM_MachineADDR(5) = T_ADDR6
COMM_MachineADDR(6) = T_ADDR7
For I = 7 To StioNum
COMM_MachineADDR(I) = &H20& + I - 7 '多余站點地址從20開始
Next I
COMM_MachineADDR(48) = PC_ADDR1
COMM_MachineADDR(49) = PC_ADDR2
COMM_MachineADDR(50) = CAN_ADDR
'COMM_MachineADDR = Array(T_ADDR1, T_ADDR2, T_ADDR3, T_ADDR4, T_ADDR5, T_ADDR6, T_ADDR7, PC_ADDR1, PC_ADDR2, CAN_ADDR)
'If StioNum > 6 Then '增加下位機地址
'   Dim num As Integer
'   num = UBound(COMM_MachineADDR)
'   ReDim Preserve COMM_MachineADDR(num + StioNum - 6)
'   Dim I As Integer
'   For I = 1 To StioNum - 6
'     COMM_MachineADDR(num + I) = &H15& + I
'   Next I
'End If
Open logfileName For Binary As #1
'存儲和提取數據模塊的初始化
SED_Init 'DataBaseObj
'WaitSendFlagNum = 0 '等待發送標志計數值
ReDim COMM_CMDGroup(0) '0號單元不用

End Sub

Private Sub COMM_PacketData(cmd As Byte, ADDR As Byte, data() As Byte, senddata() As Byte)
 'cmd  為下傳命令
 'addr 為下傳的地址
 'data 為需下傳的原始數據
 'senddata 為打包好的數據
 'Put #1, , "start_FUN_comm_packetdata: cmd: " & Hex(cmd) & vbCr & vbLf
Dim start As String, I, K As Integer
Dim ub, lb, num As Integer, t As Byte
Dim LenIn As Integer, LenOut As Integer, RealLen As Integer
ReDim senddata(100) As Byte

      senddata(0) = PKStart
      senddata(1) = ADDR
      
      senddata(2) = MyMachineAdd 'PC_ADDR1 '本機地址
      senddata(3) = 0
      senddata(4) = cmd
      COMM_CurCmd = cmd '當前包類型
    If (cmd = UP_UI Or cmd = UP_TIME) Then
      '上傳
   
      LenIn = 5
       
    ElseIf cmd = UP_HISRECORD Then
      '上傳歷史數據＋包號，共280記錄
    
      
      t = (COMM_CurHisPackIndex And &HFF00&) / 256
      senddata(5) = t ' 取高位???
      t = (COMM_CurHisPackIndex And &HFF&)
      senddata(6) = t '取地位?????????
      LenIn = 7
     
     
    
    ElseIf (cmd = DOWN_IO Or cmd = DOWN_OCTIME Or cmd = DOWN_STDTIME Or cmd = DOWN_CANBITRATE) Then
      '下傳
      
      ub = UBound(data)
      lb = LBound(data)
      num = ub - lb + 1
      
      K = 0
      For I = 5 To 4 + num Step 1
      senddata(I) = data(lb + K)
      K = K + 1
      Next
      LenIn = 5 + num
        
    End If
    
     COMM_Add7DFlag senddata, 1, LenIn, LenOut ' 1-4之間數據尋找7D7E做轉換（除去包頭）
      
     senddata(LenOut) = COMM_GenerateCRC(senddata, 1, LenOut - 1)
     COMM_Add7DFlag senddata, LenOut, LenOut + 1, RealLen
     senddata(RealLen) = PKEND
      
     
     ReDim Preserve senddata(RealLen)
     Put #1, , "FUN_comm_packetdata_down" & ConvertChar(senddata) & vbCr & vbLf


End Sub


Private Sub COMM_Add7DFlag(dataArray() As Byte, indexS As Integer, LenIn As Integer, LenOut As Integer)
'index表明從dataarray數組的第及位開始查找
Dim istart, iend As Integer, I, K As Integer
'istart = LBound(dataArray)
'iend = UBound(dataArray)
Dim dat() As Byte
ReDim dat(200) As Byte
'Put #1, , "start_FUN_comm_add7dflag" & vbCr & vbLf

For K = 0 To indexS - 1
dat(K) = dataArray(K)
Next K
Dim Pos As Integer
Pos = indexS
'If Pos < 0 Then Pos = 0

For K = indexS To LenIn - 1 Step 1 '排除包頭和包尾
   
 If dataArray(K) = &H7E& Then
   dat(Pos) = &H7D&: dat(Pos + 1) = &H5E&
   Pos = Pos + 2
 ElseIf dataArray(K) = &H7D& Then
   dat(Pos) = &H7D&: dat(Pos + 1) = &H5D&
   Pos = Pos + 2
 ElseIf dataArray(K) = &HFF& Then
   dat(Pos) = &H7D&: dat(Pos + 1) = &H5F&
   Pos = Pos + 2
 Else
   dat(Pos) = dataArray(K)
   Pos = Pos + 1
 End If
Next K


For K = 0 To Pos - 1
dataArray(K) = dat(K)
Next K
LenOut = Pos
Erase dat
End Sub



Private Sub COMM_Add7DFlag_old(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)

'Put #1, , "start_FUN_comm_add7dflag" & vbCr & vbLf

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
 'OXFF---7d5F
 ElseIf dataArray(indexS) = &HFF& 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 = RcvDataByteIndex  'UBound(dataArray)