?? module1.bas
字號:
Attribute VB_Name = "Module1"
'目標地址
Public Const T_ADDR1 As Byte = &H1& '對應多路轉換開關連接的被測儀器
Public Const T_ADDR2 As Byte = &H2&
Public Const T_ADDR3 As Byte = &H3&
Public Const T_ADDR4 As Byte = &H4&
Public Const T_ADDR5 As Byte = &H5&
Public Const T_ADDR6 As Byte = &H6&
Public Const T_ADDR7 As Byte = &H7&
Public Const T_ADDR8 As Byte = &H8&
Public Const T_ADDR9 As Byte = &H9&
Public Const T_ADDR10 As Byte = &HA&
Public Const T_ADDR11 As Byte = &HB&
Public Const T_ADDR12 As Byte = &HC&
Public Const T_ADDR13 As Byte = &HD&
Public Const T_ADDR14 As Byte = &HE&
Public Const T_ADDR15 As Byte = &HF&
Public Const T_ADDR16 As Byte = &H10&
Public Const PC_ADDR0 As Byte = &H11& 'PC機A
Public Const PC_ADDR1 As Byte = &H12& 'PC機B
Public Const DLZ_ADDR As Byte = &H13& '多路轉換開關地址
Public Const PO7D_ADDR As Byte = &H21& 'PO7D設備地址
Public Const CNT81_ADDR As Byte = &H22& 'CNT81的設備地址
Public Const XN_ADDR As Byte = &H23& '虛擬測量設備地址
'包頭 包尾
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 = 1000 '超時時間1秒
'當前發送的命令
Public COMM_CurCmd As Byte
'當前連接的測量儀器地址
Public COMM_SurveyADDR As Byte
'包頭包尾判別標志
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(cmd As Byte, ADDR As Byte, ADDR2 As Byte, Data() As Byte, senddata() As Byte)
'cmd 為要連接的被測設備
'addr 為下傳的地址
'addr2 測量儀器
'data 為需下傳的原始數據
'senddata 為打包好的數據
Dim start As String
Dim ub, lb, num As Integer
ReDim senddata(5) As Byte
senddata(0) = PKStart '包頭
senddata(1) = DLZ_ADDR '目標地址
senddata(2) = PC_ADDR0 '源地址
senddata(3) = 0 '標志位
senddata(4) = COMM_SurveyADDR '測量設備地址
senddata(5) = cmd '連接端口地址
COMM_CurCmd = cmd '當前包類型
ReDim Preserve senddata(0 To 7) As Byte
COMM_Add7DFlag senddata, 1, 7 ' 1-7之間數據尋找7D7EFF做轉換（除去包頭）
ub = UBound(senddata)
senddata(ub - 1) = COMM_GenerateCRC(senddata, 1, ub - 2) '生成校驗碼
senddata(ub) = PKEND '添加包尾
COMM_Add7DFlag senddata, ub - 1, ub - 1 '對校驗碼進行尋找7D7EFF做轉換
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)
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) '進行7D7EFF轉換的函數防止數據失真
'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) '祛除7D5D7D5E7D5F數據,還原初始命令數據
'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
'Put #1, , COMM_SendPacket
End Sub
Public Sub overtime_timer_timer() '超時處理模塊
'Put #1, , "start_fun_overtime_timer_timer" & Chr(13)
'Put #1, , "start_fun_overtime_timer_timer-comm_isackflag:--" & COMM_isACKFlag & Chr(13)
If COMM_isACKFlag = False Then
Dim tmp As Variant
ReDim RcvData(0) '清空接收緩沖區
tmp = COMM_RcVMSCOMM.InputLen
RcvDataByteIndex = 0 '接收的字節數復位
If COMM_ReSendTimes < 2 Then
COMM_ReSendTimes = COMM_ReSendTimes + 1
COMM_StartSendData
'Put #1, , "start_fun_overtime_timer_timer-resend:--" & COMM_ReSendTimes & Chr(13)
Else
'Put #1, , "start_fun_overtime_timer_timer-over" & Chr(13)
COMM_isSendOverFlag = True '復位發送完標志
COMM_ReSendTimes = 0
overtime_timer.Enabled = False
End If
Else
End If
End Sub
Public Sub COMM_End() '程序結束模塊
'Put #1, , "start_fun_comm_end" & Chr(13)
If COMM_RcVMSCOMM.PortOpen = True Then COMM_RcVMSCOMM.PortOpen = False
If COMM_SendMSCOMM.PortOpen = True Then COMM_SendMSCOMM.PortOpen = False
End Sub
Private Function ConvertChar(dat() As Byte) As String '提取數據模塊
Dim I As Integer, str As String
str = ""
For I = 0 To UBound(dat)
str = str & Format(Hex(dat(I)), "0#")
Next I
ConvertChar = str
End Function
Private Sub COMM_ReceiveData() '接收模塊
On Error Resume Next
Dim di As Variant
Dim cLen, I, num As Integer
Put #1, , "start_FUN_comm_receivedata" & Chr(13)
cLen = COMM_RcVMSCOMM.InBufferCount
Put #1, , "in_FUN_comm_receivedata_orgdata number:" & cLen & Chr(13)
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) & Chr(13)
Erase tmp
If COMM_PKStartFlag = False And COMM_PKEndFlag = False Then
RcvDataByteIndex = 0 '接收字節索引號
End If
I = 0
Do Until COMM_PKEndFlag = True Or I > cLen - 1
If di(I) = PKStart And RcvDataByteIndex = 0 Then
ReDim RcvData(0)
RcvData(0) = PKStart
ElseIf di(I) <> PKStart And RcvData(0) = PKStart Then
ReDim RcvData(0)
RcvDataByteIndex = 0
COMM_PKStartFlag = True
RcvData(RcvDataByteIndex) = di(I)
ElseIf di(I) = PKEND And RcvData(RcvDataByteIndex) <> PKEND Then
COMM_PKEndFlag = True
RcvDataByteIndex = 0
ElseIf COMM_PKStartFlag = True And COMM_PKEndFlag = False Then
RcvDataByteIndex = RcvDataByteIndex + 1
ReDim Preserve RcvData(RcvDataByteIndex)
RcvData(RcvDataByteIndex) = di(I)
End If
I = I + 1
Loop
If COMM_PKEndFlag = True Then
COMM_isACKFlag = True
overtime_timer.Enabled = False '超時無效
COMM_PKStartFlag = False
COMM_PKEndFlag = False
Put #1, , "in_FUN_comm_receivedata_comm_realdata:" & ConvertChar(RcvData) & Chr(13)
Form1.Text2.Text = ConvertChar(RcvData) '顯示接受正確的數據
ProcessRcvData
End If
End Sub
Public Sub ProcessRcvData() '接受數據錯誤的處理
Dim CRC As Byte, num, I As Integer
'Put #1, , "start_FUN_comm_processrcvdata" & Chr(13)
COMM_Del7DFlag RcvData, UBound(RcvData), UBound(RcvData) '過濾校驗位的特殊字符
CRC = COMM_CheckCRC(RcvData)
If CRC = 0 Then '校驗正確
'Put #1, , "start_FUN_comm_processrcvdata" & "crc_ok" & Chr(13)
COMM_Del7DFlag RcvData, 0, UBound(RcvData) '過濾數據中的特殊字符
Dim sourceADDR As Byte, CorrectFlag As Byte
sourceADDR = RcvData(1) '下位機地址
CorrectFlag = RcvData(2) '標志位，01正確，02錯誤
If CorrectFlag = ACK_OK Then '下位機正確接收
'Put #1, , "FUN_comm_processrcvdata" & "ack_ok_UP_no _data" & Chr(13)
COMM_ReSendTimes = 0 '重傳次數復位
COMM_isSendOverFlag = True
COMM_CurCmd = NO_CMD
'Put #1, , "FUN_comm_processrcvdata" & "ack_ok_up_nodata_reset" & Chr(13)
Form1.Picture1.BackColor = &HFF00&
Form1.Label3.Caption = "一切正常"
COMM_CurHisPackIndex = COMM_CurHisPackIndex + 1
Else
'重發，3次
Form1.Picture1.BackColor = &HFF&
Form1.Label3.Caption = "發送錯誤數據"
If COMM_ReSendTimes < 2 Then
'Put #1, , "FUN_comm_processrcvdata" & "ack_fail_resend_times-" & COMM_ReSendTimes & Chr(13)
COMM_ReSendTimes = COMM_ReSendTimes + 1 '起始值為0
COMM_StartSendData '繼續該命令的傳送
Else
'Put #1, , "FUN_comm_processrcvdata" & "ack_fail_resend_times >2 and_reset" & Chr(13)
COMM_isSendOverFlag = True
COMM_ReSendTimes = 0 '重傳 次數復位
COMM_CurCmd = NO_CMD '重傳，及命令復位
End If
End If ' end of ack-ok
Else '校驗錯誤
'Put #1, , "_FUN_comm_processrcvdata" & "crc_fail" & Chr(13)
'重發包，3次
Form1.Picture1.BackColor = &HFF&
Form1.Label3.Caption = "校驗錯誤"
If COMM_ReSendTimes < 2 Then
COMM_StartSendData '繼續該命令的傳送
Put #1, , "FUN_comm_processrcvdata" & "crc_fail_resend_times-" & COMM_ReSendTimes & Chr(13)
Else
COMM_isSendOverFlag = True
COMM_ReSendTimes = 0
COMM_CurCmd = NO_CMD ' 命令，及重發 復位
'Put #1, , "FUN_comm_processrcvdata" & "crc_fail_resend_times >2,and reset" & Chr(13)
End If
COMM_ReSendTimes = COMM_ReSendTimes + 1 '起始值為0
End If
End Sub
Public Sub MSCommCtl_OnComm() '對于觸發事件處理模塊
'Put #1, , "FUN_mscommctl_oncomm" & Chr(13)
Select Case COMM_RcVMSCOMM.CommEvent
Case comEvReceive
Call COMM_ReceiveData
Case comEvEOF
End Select
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -