spcp.bas

很好的VB编写的串口数据通讯源码,我从这个开始了我的单片机通讯之路,希望对你也是个启迪!

Attribute VB_Name = "spcp"

'*************************************************
'消息帧数据格式:
'   1   0   A   B   X   X
'其中 10 为消息标识,
'           AB表示文本长度,L=A*100+B
'               XX为配位字符,任意

'控制帧数据格式
'   0   1   A   B   M   N
'其中 01为控制标识,
'           AB为请求标识
'               MN为附加标识
'           11表示请求对方接收文件,M表示描述字串中文件名子串的长度
'                                   N表示描述字串中文件大小子串的长度
'           10通知对方放弃传输
'           00通知文件传输完毕
'           01请求对方发送数据,  MN为10请求发送下一个
'                               MN为00请求重发
                                
'数据帧数据格式
'   0   0   A   B   M   N
'其中 00 为数据标识,
'           AB表示数据长度,L=A*100+B
'           MN为校验,M*100+N=A+B
'*************************************************

'*************************************************
Public intCommFlag  As Long
'intCommFlag 是comm控件工作的标志,其意义如下:
'0  已经关闭
'1  打开,等待
'2  正在发送二进制数据
'4  正在发送文本
'8  正在发送控制符
'16 正在接收数据
'*************************************************


Public blnFileTransFlag As Boolean      '文件传输方式标志
'true 为发送
'false 为接收

Public strFileDirectary As String   '文件路径

Public strFileName As String        '文件名
Public intFileLenth As Long         '文件长度

Dim intFileNumber As Long           '文件号

'*************************************************

Dim intDataLenth As Long            '数据帧长度
Dim intDataCount As Long            '数据帧总计数
Dim intDataNumber As Long           '已经发送数据帧数

'*************************************************
Dim strSendFile As String           '"请求接收新文件"帧负载
Dim bytSendFile() As Byte           '数据帧负载


Dim bytFileBuffer() As Byte         '文件缓冲区

Dim intFileReceiveLenth As Long     '已经接收文件的字节数

Dim intReceiveLen As Long           '每次读入数据的字节数

Dim bytReceive() As Byte            '接收到的数据帧负载
'*************************************************


'****************************************************
'串口输入管理
'串行口接收到数据后即调用该过程进行处理
'****************************************************

Public Sub InputManager()
    intCommFlag = 16
    
    Dim bytTest() As Byte
    Dim strReceive As String
    
    
    Dim intTest As Long
    
    Dim strTemp As String
    
    frmMain.ctrMSComm.InputMode = comInputModeBinary
    frmMain.ctrMSComm.InputLen = 6
    
    bytTest = frmMain.ctrMSComm.Input
    ReDim Preserve bytTest(5)                                           '获取帧头
    
    If bytTest(0) = 1 And bytTest(1) = 0 Then                           '收到信息帧
        intReceiveLen = bytTest(2) * 100 + bytTest(3)
        frmMain.ctrMSComm.InputMode = comInputModeText
        frmMain.ctrMSComm.InputLen = 0
        For n = 1 To 1000000                                            '延时
        Next n
        strReceive = frmMain.ctrMSComm.Input
        strTemp = "接收:" + strReceive
        Call frmMain.ReceiveDisplay(strTemp, 2)                         '调用信息显示
        
    ElseIf bytTest(0) = 0 And bytTest(1) = 1 Then                       '收到控制帧
        intTest = bytTest(2) * 100 + bytTest(3)                         '控制帧分析
        
        Select Case intTest
            Case 101                                                    '对方请求接收新文件
                intReceiveLen = bytTest(4)
                frmMain.ctrMSComm.InputMode = comInputModeText
                frmMain.ctrMSComm.InputLen = intReceiveLen
                Do
                Loop While frmMain.ctrMSComm.InBufferCount < intReceiveLen
                strFileName = frmMain.ctrMSComm.Input                   '接收文件名信息
                
                intReceiveLen = bytTest(5)
                frmMain.ctrMSComm.InputLen = intReceiveLen
                Do
                Loop While frmMain.ctrMSComm.InBufferCount < intReceiveLen
                strReceive = frmMain.ctrMSComm.Input                    '接收文件长度信息
                
                strReceive = LTrim(strReceive)
                intFileLenth = Val(strReceive)                          '文件长度
                
                If MsgBox("对方发送文件" + strFileName + "," + Chr(13) + "文件大小为 " + Str(intFileLenth) + "字节" + Chr(13) + "是否接收?", vbOKCancel) = vbOK Then
                    Call FileReceiveManager(0)
                End If
                intCommFlag = 1
                
            Case 100                                                    '对方通知放弃传输
                
            Case 1                                                      '对方请求发送数据
                If bytTest(4) = 1 Then                                  '请求发送数据包
                    intDataNumber = intDataNumber + 1
                    If intDataNumber > intDataCount Then
                        Call FileSendManager(4)                         '发送完成信号
                    Else
                        Call FileSendManager(1)                         '发送新一帧数据
                    End If
                Else
                    Call FileSendManager(2)                             '重发上一帧数据
                End If
                intCommFlag = 1
            Case 0                                                      '接收到传输完毕信号
                Call FileReceiveManager(4)
                intCommFlag = 1
                
            Case Else
            
        
        
        End Select
        
    ElseIf bytTest(0) = 0 And bytTest(1) = 0 Then                       '收到数据帧
        intCommFlag = 16
        intTest = bytTest(4) * 100 + bytTest(5)
        intReceiveLen = bytTest(2) * 100 + bytTest(3)                   '数据字节数
        frmMain.ctrMSComm.InputMode = comInputModeBinary
        frmMain.ctrMSComm.InputLen = intReceiveLen
        ReDim bytReceive(intReceiveLen - 1)
        Do
        Loop While frmMain.ctrMSComm.InBufferCount < intReceiveLen
        bytReceive = frmMain.ctrMSComm.Input
        
        If intTest = bytTest(2) + bytTest(3) Then                       '根据校验和作出响应
            
            Call FileReceiveManager(1)                                  '校验和正确请求发送新数据
        Else
            Call FileReceiveManager(2)                                  '校验和错请求重新发送
        End If
            
        intCommFlag = 1
        
    Else
        intCommFlag = 1
    End If
    
    
    
    intCommFlag = 1
End Sub

'************************************************************
'文件发送管理
'根据接收端的请求发送文件
'************************************************************



Public Sub FileSendManager(intFlag As Long)
    Dim bytTest(5) As Byte
    Dim bytSend() As Byte
    Dim intSendLen As Long
    
    Dim intProgress
   
    Select Case intFlag
        Case 0                                                          '发送新文件
            intCommFlag = 8
            
            intFileNumber = FreeFile
            Open strFileDirectary For Binary As #intFileNumber          '打开文件
            
            intFileLenth = LOF(intFileNumber)                           '获得文件长度
            
            
            ReDim bytFileBuffer(intFileLenth - 1)
            Get #intFileNumber, , bytFileBuffer                         '将文件读入缓冲区
            
            bytTest(0) = 0                                              '组织帧头