dim Const ACK = 6
       dim T as long 
       dim Const AskConnect = "~~~"
       MSComm1.InputLen = 1
       Dim ask000
       ask000 = 0
    Do
        Success = False
        If Not MSComm1.PortOpen Then MSComm1.PortOpen = True
        MSComm1.InputLen = 0
        inBUF = MSComm1.Input
        MSComm1.InputLen = 1
        MSComm1.Output = AskConnect & vbCrLf
        ask000 = ask000 + 1
        Debug.Print ask000
        T = Timer + 1
        Do Until Timer > T
            If MSComm1.InBufferCount > 0 Then
                inBUF = ""
                inBUF = MSComm1.Input
                If inBUF = ChrB(ACK) Then
                    Success = True
                    Exit Do
                End If
            End If
            Ret = DoEvents()
        Loop
        If Success Then Exit Do
    Loop Until UserCancel
疑难点:MSComm1.Output = AskConnect & vbCrLf是什么意思,ChrB(ACK)值又是多少?请帮忙,万分感谢!解决马上给分,决不食言!(最好能给出具体每一行的解释)

解决方案 »

  1.   

    1)MSComm1.Output = AskConnect & vbCrLf是什么意思
      向串口写"~~~"并最后带有回车。2)ChrB always returns a single byte
      

  2.   

    呵,意思我也已经明白了.MSComm1.Output = AskConnect & vbCrLf是向串口写"~~~",那ChrB(ACK)的值是多少呢?
      

  3.   

    这些代码是我的串口通讯程序的一部分,这部分代码应该是检测串口是否有响应,首先发"~~~"串到串口,然后inBUF = MSComm1.Input读取,但为何当inBUF = ChrB(ACK)的时候就确定串口有响应呢?同时ChrB(ACK)的值是不是等于6啊?请问此判断是否有误?还有,Timer的值返回多少,谢谢!
      

  4.   

    总的意思是向通信机发送一个连接请求,并等待对方返回ACK信号。“ACK”是通信中的一个缩写,意思是成功的握手。dim Const ACK = 6      '定义了ACK信号的ASCII码代码,6大概是CTRL+F
    Dim T As Long
    dim Const AskConnect = "~~~"    '定义请求连接的命令
    MSComm1.InputLen = 1    '设置串口接受长度为1,即接到1个字符就产生oncomm事件
    Dim ask000      '调试用变量,看多少次成功
    ask000 = 0
    Do
        Success = False     '初始化成功标志为False
        
        '以下为设置串口的工作模式和打开串口
        If Not MSComm1.PortOpen Then MSComm1.PortOpen = True
        MSComm1.InputLen = 0
        inBUF = MSComm1.Input
        MSComm1.InputLen = 1
        '串口设置结束
        
        MSComm1.Output = AskConnect & vbCrLf    '发送连接请求命令
        ask000 = ask000 + 1
        Debug.Print ask000
        T = Timer + 1       '设置一个超时时间,即过了此时间未接到正确的数据,则认为本次通信失败
        Do Until Timer > T  '是否超过了预期的时间
            If MSComm1.InBufferCount > 0 Then   '串口的接受缓冲区中是否有数
                inBUF = ""
                inBUF = MSComm1.Input   '接受数据
                If inBUF = ChrB(ACK) Then   '判断接受到的是否为ACK信号
                    Success = True  '正确接受到则设置成功标志并退出
                    Exit Do
                End If
            End If
            Ret = DoEvents()
        Loop
        If Success Then Exit Do     '判断成功标志并退出
    Loop Until UserCancel   '根据外部的取消标志判断是否继续。
      

  5.   

    呵呵,不是串口是否有响应,而是和串口相连接的设备是否有响应,比如一个读卡机什么的。你可以把那个设备也看作一台计算机,通信就像两个人之间的通话,你先向它喊一句“~~~”,如果它正常的话,它会回答你一个ACK,这里就是ASCII码的6,代表它接到了你的信息。
      

  6.   

    请问一下:
    do until...loop 和 do ...loop until有什么区别啊?
      

  7.   

    前者先判断在执行,后者是先执行在判断,实际的区别就在于前者可能do和loop之间的语句一次也可能执行不到,后者至少会执行到1次。
      

  8.   

    感谢AresChen朋友的回答,现在我遇到的情况是程序没法运行到 If MSComm1.InBufferCount > 0 Then这条语句,也就是串口的接受缓冲区中一直没有数据,这是为何?因为串口通讯是在两台电脑之间进行的,但当我把串口线从一台电脑取下,而另一电脑仍打开串口通讯,然后把另一头接到MODEN里(MODEN是打开的).这时候程序就执行到If MSComm1.InBufferCount > 0了,也即缓冲区中有了数据,请问这是何原因,望答复,感谢!!
      

  9.   

    首先问你一个问题,你不要哭啊,呵呵:
    1,另一台电脑中,你运行了接受到“~~~”后可以发送一些数据,比如ACK的程序了吗?
    如果没有,请运行;如果有,请看2。
    2,两边的端口设置是否正确,其中除了端口号可以不一样以外,速率、奇偶校验位、停止位等应该都一样。确定正确到3,否则请设置正确。
    3,另一台电脑的串口是否损坏,串口不能支持热插拔,如果带电插拔的话,很容易损坏。检验的办法,连上modem,看看是否可以正常拨号上网。没有损坏到4,否则换个串口或换个机子。
    4,连接用串口线是否正确?正确的串口线,应该使用2、3、5线(好像是,3、4年没碰串口了,记不清了),其中2、3线是数据线,电脑与电脑之间连接的,应该是2、3交叉、5直接联通。串口线正确到5,否则换根串口线。
    5,~~~~~把程序发给我吧,我帮你调。发的话请留回复帖子告诉,否则~~~就这样吧。呵呵,我能想到的就这些了,不行就只有5了。
      

  10.   

    感谢AresChen,我先试试再说哦,呵.
      

  11.   

    AresChen朋友,我照你的方法做了,确定串口没有问题,串口线应该也没问题,因为都是用同一根线通过MODEN拨号上网的.:)  我是没办法了,现在我把代码贴出来,希望能帮我看看,谢谢Function sendFile(FName$) As String   'FName$是文件名
        Dim FileName As String * 20
        Dim FileLenth As String * 10
        Dim FileCreateTime As String * 20
        Dim FilePath As String * 64
        Dim T As Long
        
        Dim Success As Boolean
        Dim inBUF As Variant
        Dim OutBUF() As Byte
        Dim ASKTimes As Integer
        Dim Ret As Long
        Dim HSend As Long
        
        On Error Resume Next
        sendFile = ""
        
        FileName = Space(20)
        FileLenth = Space(10)
        FileCreateTime = Space(20)
        FilePath = (64)    FileName = Dir(FName)
        FilePath = Left(FName, Len(FName) - Len(Dir(FName)) - 1)
        FileLenth = CStr(FileLen(FName))
        FileCreateTime = Format(FileDateTime(FName), "YYYY/MM/DD HH:NN:SS")
        
        '请求发送
    SEND0:
        UserCancel = False
        MSComm1.InputLen = 1
        Dim ask000
        ask000 = 0
        Do
            Success = False
            If Not MSComm1.PortOpen Then MSComm1.PortOpen = True
            MSComm1.InputLen = 0
            inBUF = MSComm1.Input
            MSComm1.InputLen = 1
            MSComm1.Output = AskConnect & vbCrLf
            ask000 = ask000 + 1
            Debug.Print ask000
            T = Timer + 1
            Do Until Timer > T
                If MSComm1.InBufferCount > 0 Then
                    inBUF = ""
                    inBUF = MSComm1.Input
                    If inBUF = ChrB(ACK) Then
                        Success = True
                        Exit Do
                    End If
                End If
                Ret = DoEvents()
            Loop
          
            If Success Then Exit Do
        Loop Until UserCancel
        
        If UserCancel Then Exit Function
        
        '请求成功,发送文件头
        ReDim OutBUF(127)
        OutBUF = StrConv(Space(128), vbFromUnicode)
        OutBUF = StrConv("~~~~~", vbFromUnicode) & _
                 StrConv(FileName, vbFromUnicode) & _
                 StrConv(FileLenth, vbFromUnicode) & _
                 StrConv(FileCreateTime, vbFromUnicode) & _
                 StrConv(FilePath, vbFromUnicode) & StrConv(Space(9), vbFromUnicode)
        
    Send1:
        Success = False
        T = Timer + 5
        MSComm1.InBufferCount = 0
        MSComm1.Output = OutBUF
        Do
            If MSComm1.InBufferCount > 0 Then
                inBUF = MSComm1.Input
                Select Case inBUF
                Case ChrB(ACK)
                    Success = True: Exit Do
                Case ChrB(NAK)
                    GoTo Send1
                End Select
            End If
            Ret = DoEvents
            ASKTimes = ASKTimes - 1
        Loop Until Timer > T
        
        If Not Success Then Exit Function
        
        '发送文件内容
        ' 打开文件。
        HSend& = FreeFile
        Err.Clear
        Open FName For Binary Access Read As HSend
        If Err Then
           ShowData txtTerm, vbCrLf & "文件: " & FileName & "打开失败!"
           Exit Function
        End If
        Dim BSize
        ' 把文件读到传输缓冲区尺寸的块中。
        BSize = MSComm1.OutBufferSize
        Dim LF&
        LF& = LOF(HSend)
        ShowData txtTerm, vbCr & "文件: " & FileName & "正在发送!"
        Success = False
        MSComm1.InBufferCount = 0
        
        Do Until Loc(HSend) >= LF Or UserCancel
            
            ' 计算结尾处数据。
            If LF& - Loc(HSend) <= BSize Then
                BSize = LF& - Loc(HSend)
            End If
            ' 读数据块。
            ReDim OutBUF(BSize - 1)
            Get HSend, , OutBUF
            ' 传输此块。
            Err.Clear
            MSComm1.Output = OutBUF
            sbrStatus.Panels(1).Text = "状态: 已发送 " & CStr(Loc(HSend)) & "字节"
            If Err Then
               ShowData txtTerm, vbCr & "文件: " & FileName & "Error: " & Error$
               Exit Do
            End If
            
            ' 等待所有数据被发送。
            Do
               Ret = DoEvents()
            Loop Until MSComm1.OutBufferCount = 0
        
        Loop
        T = Timer + 5
        MSComm1.InputLen = 1
        inBUF = ""
        Do
            If MSComm1.InBufferCount > 0 Then
               inBUF = MSComm1.Input
               If AscB(inBUF) = AscB("C") Then
                    ShowData txtTerm, ".......失败!"
                    Dim tmpFile As String
                    tmpFile = Right$(FName, 10)
                    Name FName As errPath & "\" & tmpFile
                    GoTo SEND0
                 ElseIf AscB(inBUF) = AscB("B") Then
                    ShowData txtTerm, ".......完成!时间:" & Format(Now, "yyyy-mm-dd hh:mm:ss")
                    sendFile = "s_send"
                    Exit Do
                 ElseIf AscB(inBUF) = AscB("A") Then
                    ShowData txtTerm, ".......完成!时间:" & Format(Now, "yyyy-mm-dd hh:mm:ss")
                    sendFile = "s_recieve"
                    Exit Do
                 End If'             If inBUF = ChrB(CAN) Then
    '                ShowData txtTerm, ".......失败!"
    '                GoTo SEND0
    '             ElseIf inBUF = ChrB(ACK) Then
    '                ShowData txtTerm, ".......完成! 继续发送"
    '                sendFile = "s_send"
    '
    '                Exit Do
    '             ElseIf inBUF = ChrB(SND) Then
    '                ShowData txtTerm, ".......完成! 转为接收状态"
    '                sendFile = "s_recieve"
    '                Exit Do
    '             End If
            End If
        Loop Until Timer > T
        Close #HSend
        On Error GoTo 0
    End Function
      

  12.   

    Function recieveFile() As String
        
        Dim inBUF As Variant
        Dim Ret As Long
        Dim p1 As Integer, p2 As Integer
        Dim LocalPath$
        Dim rfName As String
        Dim rfLen As String
        Dim rfDate As String
        Dim rfPath As String
        Dim rfHand As Long
        Dim TMP As String
        Dim i, T    'Open the log file to record run status and errors
        On Error Resume Next
        MSComm1.InputMode = comInputModeBinary
        MSComm1.RThreshold = 0
        If Not MSComm1.PortOpen Then MSComm1.PortOpen = True
        If Err Then
            ShowData txtTerm, vbCr & Err.Description
            'Call initproc
            Exit Function
        End IfWaiting_Connect:
        UserCancel = False
        inBUF = "": MSComm1.InBufferCount = 0
        Do
            sbrStatus.Panels(1).Text = "状态: 接收已启动, 等待连接......"
            If MSComm1.InBufferCount > 0 Then
                inBUF = inBUF & StrConv(MSComm1.Input, vbUnicode)
            End If
            If InStrB(inBUF, AskConnect) > 0 Then
                '有连接请求
                sbrStatus.Panels(1).Text = "状态: 收到连接请求......"
                Exit DoEnd If
            Ret = DoEvents
        Loop Until UserCancel
        
        If UserCancel Then Exit Function
        
        inBUF = ""
        Err.Clear
        MSComm1.InBufferCount = 0
        MSComm1.Output = ChrB(ACK) & ChrB(ACK) & ChrB(ACK) & vbCr
        
        T = Timer + 5
        Do
            If MSComm1.InBufferCount > 0 Then GoTo Rev1
            DoEvents
        Loop Until Timer > T
        
        MSComm1.Output = ChrB(CAN) & vbCrLf
        GoTo Waiting_Connect
        
    Rev1:
        '接收文件信息块
        MSComm1.InputLen = 0
        For i = 1 To 3
            Ret = False
            T = Timer + 100
            Do           '信息块长度128
                DoEvents
                If MSComm1.InBufferCount > 0 Then inBUF = inBUF & MSComm1.Input
                If LenB(inBUF) >= 128 Then
                    Exit Do
                End If
            Loop Until Timer > T
            
            If LenB(inBUF) >= 128 Then
                inBUF = StrConv(inBUF, vbUnicode)
                p1 = InStr(1, inBUF, "~~~~~")
                If p1 > 0 And p1 < 4 Then
                    rfName = Trim$(Mid(inBUF, p1 + 5, 20))
                    rfLen = Trim$(Mid(inBUF, p1 + 25, 10))
                    rfDate = Trim$(Mid(inBUF, p1 + 35, 20))
                    rfPath = Trim$(Mid(inBUF, p1 + 55, 64))
                    Ret = True
                    Exit For
                Else
                    inBUF = MSComm1.Input
                    inBUF = ""
                    MSComm1.Output = ChrB(NAK)
                End If
            Else
                Exit For
            End If
        Next i
        'MSComm1.InputLen = 1
        If Not Ret Then MSComm1.Output = CAN: GoTo Waiting_Connect
        
        '判定是否使用对方指定的文件路径
        If RemotePath Then
            '使用对方指定的目录
            If Dir(rfPath, vbDirectory) = "" Then
                '对方指定的目录不存在,试图创建
                Err.Clear
                MkDir rfPath
                If Err Then
                    '不能创建指定目录, 使用临时目录
                    rfPath = App.Path & "\temp"
                    ShowData txtTerm, vbCr & "不能创建文件" & rfName & "指定的目录, 使用临时目录"
                End If
            End If
        Else
            '不使用对方指定的目录,
            '检查文件类型
            LocalPath$ = ""
            For i = 0 To TypeNum - 1
                If UCase(Right(Trim(rfPath), 5)) = "PHOTO" Then
                    If UCase(Right(rfName, 3)) = FileType(i) Then LocalPath = FilePath(i) & "\Photo"
                Else
                    If UCase(Right(rfName, 3)) = FileType(i) Then LocalPath = FilePath(i)
                End If
            Next i
            
            If LocalPath = "" Then
                '类型不符, 使用临时目录
                ShowData txtTerm, vbCr & rfName & "类型本地无定义, 使用临时目录!"
                rfPath = App.Path & "\temp"
            Else
                rfPath = LocalPath
            End If
        End If
        
        rfHand = FreeFile
        TMP = rfPath & "\" & rfName
        
        Err.Clear
        If Dir(TMP) <> "" Then
            Kill TMP
            If Err Then
                ShowData txtTerm, vbCr & "文件:" & rfName & "存在且不能覆盖,文件被放弃!"
                MSComm1.Output = ChrB(CAN) & vbCr
                GoTo Waiting_Connect
            End If
        End If
           
        Open TMP For Binary Access Write As #rfHand
        If Err Then
            ShowData txtTerm, vbCr & "文件" & rfName & "不能打开,文件被放弃!"
            MSComm1.Output = ChrB(CAN) & vbCr
            GoTo Waiting_Connect
        End If
        inBUF = ""
        
        MSComm1.InputLen = 0
        Ret = False
        ShowData txtTerm, vbCrLf & "正在接收文件:" & rfName & " 总长度:" & rfLen & "bytes"
        
        inBUF = MSComm1.Input
        MSComm1.Output = ChrB(ACK) & vbCr
        inBUF = ""
        
        '对方5秒内必须发送过来
        T = Timer + 5
        Do
            If MSComm1.InBufferCount > 0 Then GoTo RevContens
            DoEvents
        Loop Until Timer > T
        
        MSComm1.Output = ChrB(CAN) & vbCrLf
        Close #rfHand
        GoTo Waiting_Connect
        
        Dim BK As Long
        BK = 0
    RevContens:
        T = Timer + (CLng(rfLen) / 1024)
        Do
            If MSComm1.InBufferCount > 0 Then
                BK = MSComm1.InBufferCount
                ReDim BuffByte(BK - 1)
                MSComm1.InputLen = BK
                BuffByte = MSComm1.Input
                Put #rfHand, , BuffByte
                sbrStatus.Panels(1).Text = "状态: 收到 " & CStr(Loc(rfHand)) & "字节  "
                If Loc(rfHand) >= CLng(rfLen) - 1 Then
                    '接收完成,关闭文件
                    Ret = True
                    Exit Do
                End If
            End If
            DoEvents
        Loop Until Timer > T
        Close #rfHand
        '============================================================
        If Ret Then
            ShowData txtTerm, "......接收完成!时间:" & Format(Now, "yyyy-mm-dd hh:mm:ss")
               If Trim$(Dir(CodePath & "\*." & CodeType)) <> "" Then 'Dir("c:\test\*.txt") 我有文件要发
                    MSComm1.Output = "A" ' ChrB(SND) & ChrB(SND) & ChrB(SND) & vbCr   ' ChrB(CAN) & vbCr ' "K" 'ChrB(SND) & ChrB(SND) & ChrB(SND) & vbCr
                    recieveFile = "r_send"
                    File2.Refresh
                    Exit Function
               Else '请发下一个
                    MSComm1.Output = "B" ' ChrB(ACK) & ChrB(ACK) & ChrB(ACK) & vbCr
                    recieveFile = "r_recieve"
                    'ShowData txtTerm, "......send ACK to !"
                    Exit Function
               End If
        Else
            ShowData txtTerm, "......接收失败!时间:" & Format(Now, "yyyy-mm-dd hh:mm:ss")
            Kill TMP
            MSComm1.Output = "C" ' ChrB(CAN) & vbCr
            recieveFile = "r_fail"
            GoTo Waiting_Connect
        End If
        On Error GoTo 0
        '============================================================
        
    '    If Ret Then
    '        ShowData txtTerm, "......接收完成!"
    '        MSComm1.Output = ChrB(99) & ChrB(99) & ChrB(99) & vbCr
    '
    ''        MSComm1.Output = ChrB(ACK) & ChrB(ACK) & ChrB(ACK) & vbCr
    '    Else
    '        ShowData txtTerm, "......接收失败!"
    '        Kill TMP
    '        MSComm1.Output = ChrB(CAN) & vbCr
    '    End If
    '    GoTo Waiting_Connect
            
    End Function
      

  13.   

    我没有串口线,无法替你调试,所以还需要你自己调了。
    仔细看了一遍两边的connect部分,没有原则性的错误。你可以再这么试一下:
    1,加大第一段程序等待连接部分的t=timer+1的值,比如把1改成2、甚至3、4试试;
    2,在接受方,就是第二段程序中的等待连接部分这部分
    sbrStatus.Panels(1).Text = "状态: 接收已启动, 等待连接......"
    If MSComm1.InBufferCount > 0 Then
    在这里加上debug,看看到底接受到数据没有,或者接收到的是什么东西。
    3,你的串口的波特率率是多少,降低一些,比如9600。
    如果两端都可用用moden,但彼此却无法通信,那我怀疑有几个情况,
    1,还是链路的问题,无论是哪端,接受到的数据可能是非法的,这可能是由端口设置不匹配、波特率过高、线路不好有干扰等各种原因造成的;
    2,时序不匹配,接受端的反应迟缓,总是造成发送端超时。
    你先试一下,有测试环境的朋友也可以帮忙调一下,我没有串口线,只能帮你读程序了。
    唉~~~几年前的程序都丢光了,否则直接给你一个了。
      

  14.   

    你写两个程序,一个程序按下按钮就发送几个文本,另一个oncomm事件中一接到数就显示出来,都是最简单的程序就行,然后试一下。我总是感觉,你现在连两台机子间的链路是否通了都不知道。
    顺便说一句,一般计算机都有两个串口,我以前调这种通信程序都是在一台机子上调。
      

  15.   

    没有握手成功?我怀疑就没有产生Oncomm事件,建议你把接收部分写到oncomm事件里边。
    按楼上说的在试试,如果串口没有问题的话,是不是你的串口线有毛病?