frmterminal.frm

rs232通信调试

Private Sub mnuOpenLog_Click()
Dim replace
On Error Resume Next
OpenLog.Flags = cdlOFNHideReadOnly Or cdlOFNExplorer
OpenLog.CancelError = True
'从用户处获得登录文件名称。
OpenLog.DialogTitle = "Open Communications Log File"
OpenLog.Filter = "登录文件(*.LOG)|*.log|所有文件(*.*)|*.*"
Do
  OpenLog.FileName = ""
  OpenLog.ShowOpen
  If Err = cdlCancel Then Exit Sub
   Temp = OpenLog.FileName
' 如果文件已经存在, 询问用户是否希望覆盖此文件或在此文件基础上添加内容。
  Ret = Len(Dir$(Temp))
  If Err Then
       MsgBox Error$, 48
  End If
  If Ret Then
      replace = MsgBox("文件已经存在，是否覆盖" + Temp + "?", 35)
  Else
      replace = 0
  End If
  Loop While replace = 2
    ' 用户单击“确定”按钮, 则删除此文件。

  If replace = 6 Then
        Kill Temp
        If Err Then
           MsgBox Error$, 48
          Exit Sub
        End If
  End If
     ' 打开登录文件。
  hLogFile = FreeFile
  Open Temp For Binary Access Write As hLogFile
  If Err Then
        MsgBox Error$, 48
        Close hLogFile
        hLogFile = 0
        Exit Sub
  Else
        ' 到文件结尾处来添加新数据。
      Seek hLogFile, LOF(hLogFile) + 1
  End If
  frmTerminal.Caption = "VISIUAL BASIC 终端" + OpenLog.FileTitle
  mnuOpenLog.Enabled = False
  tbrToolBar.Buttons("OpenLogFile").Enabled = False
  mnuCloseLog.Enabled = True
  tbrToolBar.Buttons("CloseLogFile").Enabled = True
  
End Sub


Private Sub mnuProperties_Click()
'弹出通讯属性设置对话框
frmProperties.Show vbModal
End Sub

Private Sub mnuSendText_Click()
Dim hSend, BSize, LF&
On Error Resume Next
mnuSendText.Enabled = False
tbrToolBar.Buttons("TransmitTextFile").Enabled = False
'从用户处获得文本文件名称。
OpenLog.DialogTitle = "Send Text File"
OpenLog.Filter = "Text Files(*.TXT)|*.txt|All Files(*.*)|*.*"
Do
      OpenLog.CancelError = True
      OpenLog.FileName = ""
      OpenLog.ShowOpen
      If Err = cdlCancel Then
           mnuSendText.Enabled = True
           tbrToolBar.Buttons("TransmitTextFile").Enabled = True
           Exit Sub
      End If
      Temp = OpenLog.FileName
      ' 如果文件不存在，则返回。
      Ret = Len(Dir$(Temp))
      If Err Then
           MsgBox Error$, 48
           mnuSendText.Enabled = True
          Exit Sub
      End If
      If Ret Then
           Exit Do
      Else
           MsgBox Temp + "没有找到!", 48
      End If
Loop
'打开登录文件。
hSend = FreeFile
Open Temp For Binary Access Read As hSend
If Err Then
     MsgBox Error$, 48
Else
      ' 显示“取消”对话框。
     CancelSend = False
     frmCancelSend.label1.Caption = "正在发送文本文件：" + Temp
     frmCancelSend.Show
    '把文件读到传输缓冲区尺寸的块中。
     BSize = MSComm1.OutBufferSize
     LF& = LOF(hSend)
     Do Until EOF(hSend) Or CancelSend
     '在结尾处不要读太多数据。
         If LF& - Loc(hSend) <= BSize Then
             BSize = LF& - Loc(hSend) + 1
         End If
         '读数据块。
         Temp = Space$(BSize)
          Get hSend, , Temp
         '传输此块。
          MSComm1.Output = Temp
         If Err Then
              MsgBox Error$, 48
              Exit Do
          End If
          '等待所有数据被发送。
          Do
             Ret = DoEvents()
          Loop Until MSComm1.OutBufferCount = 0 Or CancelSend
     Loop
End If
Close hSend
mnuSendText.Enabled = True
tbrToolBar.Buttons("TransmitTextFile").Enabled = True
CancelSend = True
frmCancelSend.Hide
End Sub

Private Sub mnuSettings_Click()
'弹出通讯端口参数设置对话框
frmSettings.Show vbModal
End Sub

Private Sub MSComm1_OnComm()
' OnComm 事件被用于捕获 communications 事件及错误。
Dim EVMsg$   '存放事件消息的字符串
Dim ERMsg$   '存放错误消息的字符串
'根据事件消息进行分支
Select Case MSComm1.CommEvent
     '以下为事件消息
     Case comEvReceive
          Dim Buffer As Variant
          Buffer = MSComm1.Input
          Debug.Print "Receive-" & StrConv(Buffer, vbUnicode)
          ShowData txtTerm, (StrConv(Buffer, vbUnicode))
     Case comEvSend
     Case comEvCTS
          EVMsg$ = "CTS信号发生改变！"
     Case comEvDSR
          EVMsg$ = "DSR信号发生改变！"
     Case comEvCD
          EVMsg$ = "CD信号发生改变！"
     Case comEvRing
          EVMsg$ = "检测到电话振铃！"
     Case comEvEOF
          EVMsg$ = "收到文件结束符！"
     '以下为错误消息
     Case comBreak
          ERMsg$ = "收到中断信号！"
     Case comCDTO
          ERMsg$ = "CD超时！"
    Case comCTSTO
          ERMsg$ = "CTS超时！"
    Case comDCB
          ERMsg$ = "Error retrieving DCB"
    Case comDSRTO
          ERMsg$ = "DSR超时！"
    Case comFrame
         ERMsg$ = "帧出错！"
    Case comOverrun
         ERMsg$ = "端口超限！"
    Case comRxOver
         ERMsg$ = "接收缓冲区溢出！"
    Case comRxParity
         ERMsg$ = "校验错！"
    Case comTxFull
         ERMsg$ = "发送缓冲区溢出！"
    Case Else
         ERMsg$ = "未知事件或错误！"
End Select
If Len(EVMsg$) Then
     ' 在状态栏中显示事件信息。
        sbrStatus.Panels("Status").Text = "Status: " & EVMsg$
        ' 使计时器可用，这样在2秒钟之后状态栏中的信息将被清除。
        Timer2.Enabled = True
ElseIf Len(ERMsg$) Then
        ' 在状态栏中显示事件信息。
        sbrStatus.Panels("Status").Text = "状态: " & ERMsg$
        
        ' 在告警信息对话框中显示错误信息。
    Beep
    Ret = MsgBox(ERMsg$, 1, "按下取消退出,确定忽略错误。")
    ' 如果用户单击“取消” (2)...
     If Ret = 2 Then
         MSComm1.PortOpen = False ' 关闭端口且退出。
    End If
    ' 使计时器可用，这样在2秒钟之后状态栏中的信息将被清除。
    Timer2.Enabled = True
End If
End Sub
Private Static Sub ShowData(Term As Control, Data As String)
' 这个过程添加数据到 Term 控件的 Text 属性。
' 它也过滤控制字符，如空格,
' 回车, 换行, 并且写数据到
' 一个打开的登录文件。
' 空格符从它的左侧删除，
' 在 Text 属性, 或者从传递字符串中。
' 换行符将被修改为回车。
' Term 控件的 Text 属性的尺寸也被监视
' 使它不能超过 MAXTERMSIZE 的要求。
On Error GoTo Handler
    Const MAXTERMSIZE = 16000
    Dim TermSize As Long, i
    
    ' 确定现存的文本不会太大。
    TermSize = Len(Term.Text)
    If TermSize > MAXTERMSIZE Then
       Term.Text = Mid$(Term.Text, 4097)
       TermSize = Len(Term.Text)
    End If

    ' 指到 Term 的数据的结尾处。
    Term.SelStart = TermSize

    ' 过滤/处理空格符。
    Do
       i = InStr(Data, Chr$(8))
       If i Then
          If i = 1 Then
             Term.SelStart = TermSize - 1
             Term.SelLength = 1
             Data = Mid$(Data, i + 1)
          Else
             Data = Left$(Data, i - 2) & Mid$(Data, i + 1)
          End If
       End If
    Loop While i

    ' 除去换行符。
    Do
       i = InStr(Data, Chr$(10))
       If i Then
          Data = Left$(Data, i - 1) & Mid$(Data, i + 1)
       End If
    Loop While i

    ' 确定所有的回车都包含换行符。
    i = 1
    Do
       i = InStr(i, Data, Chr$(13))
       If i Then
          Data = Left$(Data, i) & Chr$(10) & Mid$(Data, i + 1)
          i = i + 1
       End If
    Loop While i

    ' 添加过滤的数据到 SelText 属性。
    Term.SelText = Data
  
    ' 如果需要记录数据到文件
    If hLogFile Then
       i = 2
       Do
          Err = 0
          Put hLogFile, , Data
          If Err Then
             i = MsgBox(Error$, 21)
             If i = 2 Then
                mnuCloseLog_Click
             End If
          End If
       Loop While i <> 2
    End If
    Term.SelStart = Len(Term.Text)
Exit Sub

Handler:
    MsgBox Error$
    Resume Next
End Sub

Private Sub tbrToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
'处理工具栏上的按扭被点击的事件
Select Case Button.Key
Case "OpenLogFile"
    Call mnuOpenLog_Click
Case "CloseLogFile"
    Call mnuCloseLog_Click
Case "DialPhoneNumber"
    Call mnuDial_Click
Case "HangUpPhone"
    Call mnuHangup_Click
Case "Properties"
    Call mnuProperties_Click
Case "TransmitTextFile"
    Call mnuSendText_Click
End Select
End Sub

Private Sub Timer1_Timer()
'计时器Timer1的作用是在状态栏上显示连接时间
sbrStatus.Panels("ConnectTime").Text = Format(Now - StartTime, "hh:mm:ss") & " "
End Sub

Private Sub Timer2_Timer()
'定时器Timer2显示当前的通讯状态
sbrStatus.Panels("Status").Text = "通讯状态："
Timer2.Enabled = False
End Sub

Private Sub txtTerm_KeyPress(KeyAscii As Integer)
' 击键在这里被捕获，他们被送到 MSComm 控件
' 然后经由OnComm (comEvReceive) 事件返回, 并且
' 和 ShowData 过程被显示。
If MSComm1.PortOpen Then
    MSComm1.Output = Chr$(KeyAscii)
    If Not Echo Then
        txtTerm.SelStart = Len(txtTerm)
        KeyAscii = 0
    End If
End If
End Sub
Private Sub StartTiming()
'调用此函数启动连接时间计时器
    StartTime = Now
    Timer1.Enabled = True
End Sub
Private Sub Stoptiming()
'调用此函数停止计时
    sbrStatus.Panels("ConnectTime").Text = ""
End Sub