?? communication.bas
字號:
'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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -