main.bas

利用MSCOMM串口通信控件进行异步串行通信的文件传输程序设计

Attribute VB_Name = "Module1"
'定义模块变量
Public intCommFlag As Long
Public blnFileTransFlag As String  '文件传输方式标志
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 intoutbuffersize As Long  '输入输出缓冲区大小



'串行口接收到数据后即调用该过程进行处理
Public Sub InPutManager()
  intCommFlag = 16
  Dim bytTest() As Byte
  Dim strReceive As String
  Dim intTest As Long
  Dim strTemp As String
  Form1.MSComm1.InputMode = comInputModeBinary
  Form1.MSComm1.InputLen = 6
  bytTest = Form1.MSComm1.Input
  ReDim Preserve bytTest(5)
  If bytTest(0) = 1 And bytTest(1) = 0 Then
      intReceiveLen = bytTest(2) * 100 + bytTest(3)
      Form1.MSComm1.InputMode = comInputModeText
      Form1.MSComm1.InputLen = 0
      For n = 1 To 1000000
      Next n
      strReceive = Form1.MSComm1.Input
      strTemp = " 接收:" + strReceive
     MsgBox (strTemp)
     
  ElseIf bytTest(0) = 0 And bytTest(1) = 1 Then
     intTest = bytTest(2) * 100 + bytTest(3)
     Select Case intTest
            Case 101  '对方请求接收新文件
                  intReceiveLen = bytTest(4)
                  Form1.MSComm1.InputMode = comInputModeText
                  Form1.MSComm1.InputLen = intReceiveLen
                  Do
                  Loop While Form1.MSComm1.InBufferCount < intReceiveLen
                  strFileName = Form1.MSComm1.Input '接收文件名信息
                  
                  intReceiveLen = bytTest(5)
                  Form1.MSComm1.InputLen = intReceiveLen
                  
                  
                ' Do
                '  Loop While Form1.MSComm1.InBufferCount < intReceiveLen
                  strReceive = Form1.MSComm1.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)
    Form1.MSComm1.InputMode = comInputModeBinary
    Form1.MSComm1.InputLen = intReceiveLen
    ReDim bytReceive(intReceiveLen - 1)
    Do
    Loop While Form1.MSComm1.InBufferCount < intReceiveLen
    bytReceive = Form1.MSComm1.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
               bytTest(1) = 1
               bytTest(2) = 1
               bytTest(3) = 1
               bytTest(4) = Len(strFileName)
               bytTest(5) = Len(intFileLenth)
               
               '负载中包含有文件名和长度信息
      strSendFile = strFileName + Str(intFileLenth)
          Form1.MSComm1.Output = bytTest     '发送数据
          Form1.MSComm1.Output = strSendFile
     '设置数据帧负载长度
     intDataLenth = Form1.GetOutBuffer \ 2

     intDataCount = intFileLenth \ intDataLenth ' 计算数据帧数
     If intFileLenth - intDataLenth * intDataCount > 0 Then
         intDataCount = intDataCount + 1
     End If
      
      intDataNumber = 1
      ReDim bytSendFile(intDataLenth - 1)
      For n = 1 To intDataLenth
          bytSendFile(n - 1) = bytFileBuffer(n - 1) '准备发送第一帧
          Next n
        
          intCommFlag = 1
     Case 1
     intCommFlag = 2
     If intDataNumber = intDataCount Then
           intSendLen = intFileLenth - intDataLenth * (intDataCount - 1)
     Else
           intSendLen = intDataLenth
     End If
     
     ReDim bytSendFile(intSendLen - 1)
     For n = 1 To intSendLen '加载数据
        bytSendFile(n - 1) = bytFileBuffer(intDataLenth * (intDataNumber - 1) - 1)
     Next n
     
     ReDim bytSend(5 + intSendLen)
     For n = 1 To intSendLen
         bytSend(n + 5) = bytSendFile(n - 1)
     Next n
     
     bytSend(0) = 0
     bytSend(1) = 0
     bytSend(2) = intSendLen \ 100
     bytSend(3) = intSendLen - bytSend(2) * 100
     bytSend(4) = bytSend(2) + bytSend(3)
     
     bytSend(5) = intSendLen - bytSend(4) * 100
     Form1.MSComm1.Output = bytSend '发送数据帧
Case 2   '重新发送
    intCommFlag = 2
    If intDataNumber = intDataCount Then ' 计算数据帧负载长度
       intSendLen = intFileLenth - intDataLenth * (intDataCount - 1)
       Else
          intSendLen = intDataLenth
    End If
    
     ReDim Preserve bytSendFile(intSendLen - 1) '加载数据帧
     ReDim bytSend(5 + intSendLen)
     For n = 1 To intSendLen
        bytSend(n + 5) = bytSendFile(n - 1)
     Next n
     
     bytSend(0) = 0
     bytSend(1) = 0
     bytSend(2) = intSendLen \ 100
     bytSend(3) = intSendLen - bytSend(2) * 100
     intSendLen = bytSend(2) + bytSend(3)
     bytSend(4) = intSendLen \ 100
     bytSend(5) = intSendLen - bytSend(4) * 100
      
    Form1.MSComm1.Output = bytSend
    'intProgress = intDataNumber * 100 \ intDataCount
Case 4
   intCommFlag = 8  ' 组织帧头
    bytTest(0) = 0
    bytTest(1) = 1
    bytTest(2) = 0
    bytTest(3) = 0
    bytTest(4) = 0
    bytTest(5) = 0
    Form1.MSComm1.Output = bytTest '发送完成控制帧
    Close #intFileNumber
    MsgBox ("发送完毕!")
End Select
intCommFlag = 1


          
    
     
     
     
     
End Sub
Public Sub FileReceiveManager(intFlag As Long)
  On Error GoTo FileError
  
   Dim bytTest(5) As Byte
   Select Case intFlag
        Case 0
          intCommFlag = 8
          Call Form1.save_Click ' 选择存放路径
          intFileNumber = FreeFile
          strFileDirectary = Form1.CommonDialog1.FileName
          Open strFileDirectary For Binary As #intFileNumber
          
          ReDim bytFileBuffer(intFileLenth - 1)
          intFileReceiveLenth = 0
          bytTest(0) = 0
          bytTest(1) = 1
          bytTest(2) = 0
          bytTest(3) = 1
          bytTest(4) = 0
          bytTest(5) = 0
          Form1.MSComm1.Output = bytTest '请求发送控制帧
          Form1.Label2.Caption = Str(bytTest)
          intCommFlag = 1
      Case 1
      intCommFlag = 8
      For n = 1 To intReceiveLen
      bytFileBuffer(intFilReceiveLen + n - 1) = bytReceive(n - 1)
      Next n
      intFileReceiveLenth = intFileReceiveLenth + intReceiveLen
          bytTest(0) = 0
          bytTest(1) = 1
          bytTest(2) = 0
          bytTest(3) = 1
          bytTest(4) = 1
          bytTest(5) = 0
          Form1.MSComm1.Output = bytTest '请求发送控制帧
          
     Case 2
         intCommFlag = 8
          bytTest(0) = 0
          bytTest(1) = 1
          bytTest(2) = 0
          bytTest(3) = 1
          bytTest(4) = 0
          bytTest(5) = 0
          Form1.MSComm1.Output = bytTest '请求发送控制帧
          intCommFlag = 1
    Case 4                                         '完成
         Put #intFileNumber, , bytFileBuffer      '把文件写入磁盘
         Close #intFileNumber   '关闭文件
         MsgBox ("接收完毕!")
  End Select
   intCommFlag = 1
FileError:

       
    
          
          
End Sub