frmterminal.frm

VB平台单片机与PC机串口通信的PC端程序。小巧易用

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form frmTerminal 
   Caption         =   "通信终端"
   ClientHeight    =   4935
   ClientLeft      =   2415
   ClientTop       =   1890
   ClientWidth     =   7155
   ForeColor       =   &H00000000&
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   4935
   ScaleWidth      =   7155
   Begin MSCommLib.MSComm MSComm 
      Left            =   3285
      Top             =   2175
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
   End
   Begin VB.PictureBox tbrToolBar 
      Align           =   1  'Align Top
      Height          =   420
      Left            =   0
      ScaleHeight     =   360
      ScaleWidth      =   7095
      TabIndex        =   1
      Top             =   0
      Width           =   7155
      Begin VB.Frame Frame1 
         BorderStyle     =   0  'None
         Caption         =   "Frame1"
         Height          =   240
         Left            =   4000
         TabIndex        =   2
         Top             =   75
         Width           =   240
         Begin VB.Image imgConnected 
            Height          =   240
            Left            =   0
            Stretch         =   -1  'True
            ToolTipText     =   "Toggles Port"
            Top             =   0
            Width           =   240
         End
      End
   End
   Begin VB.Timer TimerDial 
      Enabled         =   0   'False
      Interval        =   10000
      Left            =   2520
      Top             =   480
   End
   Begin VB.TextBox txtTerm 
      Height          =   3690
      Left            =   840
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Top             =   840
      Width           =   5790
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   165
      Top             =   1815
   End
   Begin VB.PictureBox OpenLog 
      Height          =   480
      Left            =   105
      ScaleHeight     =   420
      ScaleWidth      =   1140
      TabIndex        =   4
      Top             =   1170
      Width           =   1200
   End
   Begin VB.PictureBox sbrStatus 
      Align           =   2  'Align Bottom
      Height          =   315
      Left            =   0
      ScaleHeight     =   255
      ScaleWidth      =   7095
      TabIndex        =   0
      Top             =   4620
      Width           =   7155
   End
   Begin VB.PictureBox ImageList1 
      BackColor       =   &H80000005&
      Height          =   480
      Left            =   165
      ScaleHeight     =   420
      ScaleWidth      =   1140
      TabIndex        =   5
      Top             =   2445
      Width           =   1200
   End
End
Attribute VB_Name = "frmTerminal"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const MAXDIALTIMES = 3
                        
Dim Ret As Integer      ' Scratch integer.
Dim temp As String      ' Scratch string.
Dim hLogFile As Integer ' Handle of open log file.
Dim StartTime As Date   ' Stores starting time for port timer
Dim CurDB As String * INBFL
Dim CommEvent As Integer
Dim CurComm As Boolean

Public Function ATEx(ByRef ATCmd As String) As Boolean
Const MaxDlyTimeS As Long = 10
Dim i As Long
Dim Buffer As String
ATEx = False
On Error GoTo ErrorHandler
Screen.MousePointer = vbHourglass
With frmTerminal.MSComm
    .Output = ATCmd & vbCrLf
    i = 0
    Do
         Delay 1000
         Buffer = .Input
         Buffer = StrConv(Buffer, vbUnicode)
        If InStr(Buffer, "O") <> 0 And InStr(Buffer, "K") <> 0 Then
            ATEx = True
            Exit Do
        End If
        i = i + 1
        If (i Mod 3) = 0 Then
            .Output = "ATHZ&F" & vbCrLf
            Ret = frmTerminal.MSComm.DTREnable     ' Save the current setting.
            frmTerminal.MSComm.DTREnable = True    ' Turn DTR on.
            frmTerminal.MSComm.DTREnable = False   ' Turn DTR off.
            frmTerminal.MSComm.DTREnable = Ret     ' Restore the old setting.
            Delay 1000
            frmTerminal.OpenPort
            .Output = ATCmd & vbCrLf
        End If
        If i > MaxDlyTimeS Then
            ATEx = False
            frmTerminal.OpenPort
            .Output = "ATHZ&F" & vbCrLf
            Ret = frmTerminal.MSComm.DTREnable     ' Save the current setting.
            frmTerminal.MSComm.DTREnable = True    ' Turn DTR on.
            frmTerminal.MSComm.DTREnable = False   ' Turn DTR off.
            frmTerminal.MSComm.DTREnable = Ret     ' Restore the old setting.
            Exit Do
        End If
        
    Loop
    .InBufferCount = 0
End With
ErrorHandler:
    Screen.MousePointer = vbDefault
End Function

Public Sub CommDial(ByRef TelNo As String)
    Static DialTimes As Integer
    Static CurTelNo As String
    If TelNo <> "" Then
        CurTelNo = TelNo
        DialTimes = 0
    Else
        DialTimes = DialTimes + 1
        If DialTimes >= MAXDIALTIMES Then Exit Sub
    End If
    frmTerminal.MSComm.Output = "ATDT" & CurTelNo & vbCrLf  '拨号
    'CommEvent = AUTODIAL
End Sub

Private Sub Form_Load()
    On Error Resume Next
    ' Set the default color for the terminal
    txtTerm.SelLength = Len(txtTerm)
    txtTerm.SelText = ""
    txtTerm.ForeColor = vbBlue
    ' Set up status indicator light
    Me.imgConnected.ZOrder
    ' Center Form
    frmTerminal.Height = 5700
    frmTerminal.Move (Screen.Width - Width) / 2, (Screen.Height - Height - 1500) / 2
End Sub

Private Sub Form_Resize()
   ' Resize the Term (display) control
   If Me.WindowState <> vbMinimized Then
      txtTerm.Move 20, tbrToolBar.Height, frmTerminal.ScaleWidth, frmTerminal.ScaleHeight - sbrStatus.Height - tbrToolBar.Height
   ' Position the status indicator light
      Frame1.Left = ScaleWidth - Frame1.Width * 1.5
   End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim Res
If Not (Me.MSComm.PortOpen And CommReady) Then
    If CurAction = 9 Then
        FrmMain.mnuCommDial = False
        FrmMain.mnuCommHang = False
        frmTerminal.tbrToolBar.Buttons("HangUpPhone").Enabled = False
        frmTerminal.tbrToolBar.Buttons("DialPhoneNumber").Enabled = False
        FrmMain.myWindowExit (frmCommX)
    End If
    Screen.MousePointer = 0
Else
    Res = MsgBox("终止远程数据通信?!", vbQuestion + vbYesNoCancel)
    If Res = vbNo Then
        'Me.Visible = False
    ElseIf Res = vbCancel Then
        Cancel = True
    Else
        Hangup
        FrmMain.myWindowExit (frmCommX)
        Screen.MousePointer = 0
    End If
End If
End Sub

Private Sub mnuproperties_Click()
' Show the CommPort properties form
frmProperties.Show vbModal
End Sub

' This procedure adds data to the Term control's Text property.
' It also filters control characters, such as BACKSPACE,
' carriage return, and line feeds, and writes data to
' an open log file.
' BACKSPACE characters delete the character to the left,
' either in the Text property, or the passed string.
' Line feed characters are appended to all carriage
' returns.  The size of the Term control's Text
' property is also monitored so that it never
' exceeds MAXTERMSIZE characters.
Public Static Sub ShowData(Term As Control, Data As String)
    On Error GoTo Handler
    Const MAXTERMSIZE = 16000
    Dim TermSize As Long, i
    
    ' Make sure the existing text doesn't get too large.
    TermSize = Len(Term.Text)
    If TermSize > MAXTERMSIZE Then
       Term.Text = Mid$(Term.Text, 4097)
       TermSize = Len(Term.Text)
    End If

    ' Point to the end of Term's data.
    Term.SelStart = TermSize

    ' Filter/handle BACKSPACE characters.
    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

    ' Eliminate line feeds.
    Do
       i = InStr(Data, Chr$(10))
       If i Then
          Data = Left$(Data, i - 1) & Mid$(Data, i + 1)
       End If
    Loop While i

    ' Make sure all carriage returns have a line feed.
    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

    ' Add the filtered data to the SelText property.
    Term.SelText = Data
    'Term.SelText = StrConv(Data, vbFromUnicode)
  
    Term.SelStart = Len(Term.Text)
Exit Sub

Handler:
    MsgBox Error$
    Resume Next
End Sub

Private Sub MSComm_OnComm()
    ' Branch according to the CommEvent property.
    Select Case frmTerminal.MSComm.CommEvent
        ' Event messages.
        Case comEvReceive
            Rece
        Case comEvSend
        Case comEvCTS
            'EVMsg$ = "Change in CTS Detected"
        Case comEvDSR
            CommIn = False
            'EVMsg$ = "Change in DSR Detected"
        Case comEvCD
            CommIn = False
            'EVMsg$ = "Change in CD Detected"
        Case comEvRing
            'EVMsg$ = "The Phone is Ringing"
        Case comEvEOF
            CommIn = False
            'EVMsg$ = "End of File Detected"
        ' Error messages.
        Case comBreak
            CommIn = False
            'ERMsg$ = "Break Received"
        Case comCDTO
            CommIn = False
            'ERMsg$ = "Carrier Detect Timeout"
        Case comCTSTO
            CommIn = False
            'ERMsg$ = "CTS Timeout"
        Case comDCB
            CommIn = False
            'ERMsg$ = "Error retrieving DCB"
        Case comDSRTO
            CommIn = False
            'ERMsg$ = "DSR Timeout"
        Case comFrame
            'ERMsg$ = "Framing Error"
        Case comOverrun
            'ERMsg$ = "Overrun Error"
        Case comRxOver
            'ERMsg$ = "Receive Buffer Overflow"
        Case comRxParity
            'ERMsg$ = "Parity Error"
        Case comTxFull
            'ERMsg$ = "Transmit Buffer Full"
        Case Else
            'ERMsg$ = "Unknown error or event"
    End Select
    
End Sub

Private Sub TimerDial_Timer()
    CommDial ("")
End Sub

' Keystrokes trapped here are sent to the MSComm
' control where they are echoed back via the
' OnComm (comEvReceive) event, and displayed
' with the ShowData procedure.
Private Sub txtTerm_KeyPress(KeyAscii As Integer)
    ' If the port is opened...
    If frmTerminal.MSComm.PortOpen Then
        ' Send the keystroke to the port.
        frmTerminal.MSComm.Output = Chr$(KeyAscii)
      If Str(KeyAscii) = vbCr Then Delay (500)
        
        ' Unless Echo is on, there is no need to
        ' let the text control display the key.
        ' A modem usually echos back a character
        'If Not Echo Then
            ' Place position at end of terminal
            txtTerm.SelStart = Len(txtTerm)
            KeyAscii = 0
        'End If
    End If
End Sub

Private Sub tbrToolBar_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Key
Case "DialPhoneNumber"
    Call Dial
Case "HangUpPhone"
    Hangup
    FrmMain.mnuCommDial.Enabled = False
    FrmMain.mnuCommDial.Enabled = False
    frmTerminal.tbrToolBar.Buttons("HangUpPhone").Enabled = False
    frmTerminal.tbrToolBar.Buttons("DialPhoneNumber").Enabled = False
Case "Properties"
    Call mnuproperties_Click
End Select
End Sub

Private Sub Timer1_Timer()
    ' Display the Connect Time
    Timer1.Enabled = False
    sbrStatus.Panels("ConnectTime").Text = Format(Now - StartTime, "hh:nn:ss") & " "
End Sub
' Call this function to start the Connect Time timer
Private Sub StartTiming()
    StartTime = Now
    Timer1.Enabled = True
End Sub
' Call this function to stop timing
Private Sub StopTiming()
    Timer1.Enabled = False
    sbrStatus.Panels("ConnectTime").Text = ""
End Sub

Public Sub Hangup()
    On Error Resume Next
    If Not CommReady Then Exit Sub
    If CurAction = 9 Then
        FrmMain.Label1.Caption = "正在终止远程通信..."
        FrmMain.Label1.Refresh
    End If
    MSComm.Output = "+++"
    Delay 1000
    If Not ATEx("ATHZ&F") Then GoTo ExitSub
    Ret = frmTerminal.MSComm.DTREnable     ' Save the current setting.
    frmTerminal.MSComm.DTREnable = True    ' Turn DTR on.
    frmTerminal.MSComm.DTREnable = False   ' Turn DTR off.
    frmTerminal.MSComm.DTREnable = Ret     ' Restore the old setting.
    tbrToolBar.Buttons("HangUpPhone").Enabled = False
    tbrToolBar.Buttons("HangUpPhone").Enabled = False
    tbrToolBar.Buttons("DialPhoneNumber").Enabled = True
    If frmTerminal.MSComm.PortOpen Then frmTerminal.MSComm.PortOpen = False
    ' Stop the port timer
    StopTiming
    CommReady = False
ExitSub:
    PreModel_Code = -1
    CommIn = False
    If CommReady Then
        If CurAction = 9 Then
            If Err Then MsgBox "MODEM 挂断错误!" & vbCrLf & Err.number & ": " & Err.Description, vbCritical + vbOKCancel
        End If
    Else
        If CurAction = 9 Then
            FrmMain.mnuCommDial.Enabled = False
            FrmMain.mnuCommHang.Enabled = False
            frmTerminal.tbrToolBar.Buttons("HangUpPhone").Enabled = False
            frmTerminal.tbrToolBar.Buttons("DialPhoneNumber").Enabled = False
            If CurAction = 9 Then FrmMain.Label1.Caption = "远程通信终止"
        End If
        Unload frmTerminal
   End If
End Sub

Public Sub Dial()
 On Local Error Resume Next
    Static Num As String
    
    Num = "62781532" ' This is the 315 phone number
    
    ' Get a number from the user.
    Num = InputBox$("Enter Phone Number:", "Dial Number", Num)
    If Num = "" Then Exit Sub
    
    ' Open the port if it isn't already open.
    If Not frmTerminal.MSComm.PortOpen Then
       OpenPort
       ''If Err Then Exit Sub
    End If
    ' Dial the number.
    CommDial (Num)
    ' Start the port timer
    'StartTiming
End Sub

Public Sub OpenPort()
  If frmTerminal.MSComm.PortOpen Then Exit Sub
  With frmTerminal
    .MSComm.PortOpen = True
  End With
End Sub