通讯.frm

vb全站仪数据通讯

   Loop Until InStr(Buffer$, 结束符)


Print #3, Buffer$
Text2.Text = Buffer$
Cls
   
                
                Msg = "数据接收完毕，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    'Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If

 Close
End Sub


Private Sub MSComm_OnComm()
   Select Case MSComm1.CommEvent

' 错误
      Case comEventBreak   ' 收到 Break。
                Msg = "应用程序出错，系统接收到 Break 字符，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
       Case comEventCDTO   ' CD (RLSD) 超时。
                Msg = "载波检测超时。在系统规定时间内传输一个字符时，Carrier Detect 线为低电平，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
       
      Case comEventCTSTO   ' CTS Timeout。
                Msg = "Clear To Send 超时。在系统规定时间内传输一个字符时，Clear To Send 线为低电平，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      Case comEventDSRTO   ' DSR Timeout。
                Msg = "数据准备超时，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      
      Case comEventFrame   ' Framing Error
                Msg = "帧错误。硬件检测到帧错误，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      Case comEventOverrun   '数据丢失。
                Msg = "端口超限。在下一个字符到达端口之前，前一字符还没有从硬件中读走，因而丢失，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      
      
      Case comEventRxOver '接收缓冲区溢出。
      
                Msg = "接收缓冲区溢出。接收缓冲区已没有空间，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      
      
      Case comEventRxParity ' Parity 错误。
                Msg = "奇偶校验错误。硬件检测到奇偶校验错误，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      Case comEventTxFull   '传输缓冲区已满。
                Msg = "发送缓冲区满。在试图将字符传入发送缓冲区时，该缓冲区已满，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      Case comEventDCB   '获取 DCB] 时意外错误
                Msg = "在为端口获取设备控制块 (DCB) 时，发生不可预料的错误，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If

   ' 事件
      Case comEvCD   ' CD 线状态变化。
                Msg = "Carrier Detect 线的状态发生变化，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      Case comEvCTS   ' CTS 线状态变化。
                Msg = "Clear To Send 线的状态发生变化，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      Case comEvDSR   ' DSR 线状态变化。
                Msg = "Data Set Ready 线的状态发生变化，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      Case comEvRing   ' Ring Indicator 变化。
                Msg = "检测到振铃信号,不支持该事件，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      
      Case comEvReceive   ' 收到 RThreshold # of
                Msg = "收到 Rthreshold 个字符，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      
'chars.
      Case comEvSend   ' 传输缓冲区有 Sthreshold 个字符                     '
                Msg = "在传输缓冲区中有比 Sthreshold 数少的字符，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
      Case comEvEOF   ' 输入数据流中发现 EOF 字符
                Msg = "收到文件结束（ASCII 字符为 26）字符，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                Title = "中国大剑测绘系统提示"    ' 定义标题。
                Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' 用户按下“是”。
                    Unload Me    ' 完成某操作。
                Else    ' 用户按下“否”。
                    End    ' 完成某操作。
                End If
                     '
   End Select
End Sub

Private Sub Command2_Click()
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Dim Message, Default, MyValue

Dim Buffer As String

Dim Ls1 As Integer
Dim ls2 As Long
Dim Ls3 As String
'Open "COM1:" For Input As #2




Ls1 = "1"


通讯参数

MSComm1.PortOpen = True

'MSComm1.InputLen = 0

Text2.FontSize = 20

Text2.Text = "         计算机的COM" & 串行口 & "已准备好！"

Cls


            Msg = "单击确定开始发送，单击取消返回程序。"    ' 定义信息。
            Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
            Title = "中国大剑测绘系统提示"    ' 定义标题。
            Response = MsgBox(Msg, Style, Title, Help, Ctxt)
            If Response = vbYes Then    ' 用户按下“是”。
                'Unload Me    ' 完成某操作。
            
    '=============================================================
            Open Text1.Text For Input As #3
                                

                                 
                                 
                                 
                                 
                                 
                                 
                                 Do Until EOF(3)
                                 
                                 
                                 
                                       Line Input #3, Ls3
                                       
                                       Text2.Text = Ls3
                                       
                                       Cls
                                       MSComm1.Output = Ls3
                                       
                                 
                    
                    
                    
                    
                    
                    
                       
                                  Loop
                                    Msg = "数据接收完毕，单击确定完成操作，单击取消退出程序。"    ' 定义信息。
                                    Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义按钮。
                                    Title = "中国大剑测绘系统提示"    ' 定义标题。
                                    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
                                    If Response = vbYes Then    ' 用户按下“是”。
                                        'Unload Me    ' 完成某操作。
                                    Else    ' 用户按下“否”。
                                        End    ' 完成某操作。
                                    End If
     
            
            
            
            
            
            
            
            
            
            
            
            
            
            
            
            
            
            
            
            
            
            
            
            
   '===============================================
            
            Else    ' 用户按下“否”。
               Text2.Text = ""     ' 完成某操作。
               Cls
               
            End If














Close

End Sub

Private Sub Command3_Click()
    With CommonDialog1
        .FileName = "中国大剑测绘.txt"
        .Filter = "所有数据文件|*.TXT;*.DAT|数据文件(*.)|*.dat|数据文本文件(*.TXT)|*.TXT|所有文件(*.*)|*.*|"
        .DialogTitle = "请选择传出或传出文件名"
        .ShowOpen
        Text1.Text = .FileName
        
    End With
Text1.Text = Trim(Text1.Text)

End Sub

Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""

End Sub

Private Sub Text3_Change()

On Error GoTo aac

Dim Message, Title, Default, MyValue

串行口1 = CInt(Text3.Text)



If 串行口1 = 0 Then
aac:
        
        
        Message = "请输入端口号"    ' 设置提示信息。
        
        Title = "中国大剑测绘系统提示"    ' 设置标题
        Default = "8"    ' 设置缺省值。
        
        串行口1 = InputBox(Message, Title, Default)
        
        Text3.Text = 串行口1
             Option22.Value = False
        
             Option23.Value = False
             
             Option24.Value = False
Else

        Text3.Text = 串行口1
             Option22.Value = False
        
             Option23.Value = False
             
             Option24.Value = False


End If



End Sub