📄 vbterm.frm
字号:
txtTerm.SelLength = Len(txtTerm)
txtTerm.SelText = ""
txtTerm.ForeColor = vbBlue
' Set Title
App.Title = "Visual Basic Terminal"
' Set up status indicator light
imgNotConnected.ZOrder
' Center Form
frmTerminal.Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
' Load Registry Settings
Settings = GetSetting(App.Title, "Properties", "Settings", "") ' frmTerminal.MSComm1.Settings]\
If Settings <> "" Then
MSComm1.Settings = Settings
If Err Then
MsgBox Error$, 48
Exit Sub
End If
End If
CommPort = GetSetting(App.Title, "Properties", "CommPort", "") ' frmTerminal.MSComm1.CommPort
If CommPort <> "" Then MSComm1.CommPort = CommPort
Handshaking = GetSetting(App.Title, "Properties", "Handshaking", "") 'frmTerminal.MSComm1.Handshaking
If Handshaking <> "" Then
MSComm1.Handshaking = Handshaking
If Err Then
MsgBox Error$, 48
Exit Sub
End If
End If
Echo = GetSetting(App.Title, "Properties", "Echo", "") ' Echo
On Error GoTo 0
End Sub
Private Sub Form_Resize()
' Resize the Term (display) control
txtTerm.Move 0, tbrToolBar.Height, frmTerminal.ScaleWidth, frmTerminal.ScaleHeight - sbrStatus.Height - tbrToolBar.Height
' Position the status indicator light
Frame1.Left = ScaleWidth - Frame1.Width * 1.5
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim Counter As Long
If MSComm1.PortOpen Then
' Wait 10 seconds for data to be transmitted.
Counter = Timer + 10
Do While MSComm1.OutBufferCount
Ret = DoEvents()
If Timer > Counter Then
Select Case MsgBox("Data cannot be sent", 34)
' Cancel.
Case 3
Cancel = True
Exit Sub
' Retry.
Case 4
Counter = Timer + 10
' Ignore.
Case 5
Exit Do
End Select
End If
Loop
MSComm1.PortOpen = 0
End If
' If the log file is open, flush and close it.
If hLogFile Then mnuCloseLog_Click
End
End Sub
Private Sub imgConnected_Click()
' Call the mnuOpen_Click routine to toggle connect and disconnect
Call mnuOpen_Click
End Sub
Private Sub imgNotConnected_Click()
' Call the mnuOpen_Click routine to toggle connect and disconnect
Call mnuOpen_Click
End Sub
Private Sub mnuCloseLog_Click()
' Close the log file.
Close hLogFile
hLogFile = 0
mnuOpenLog.Enabled = True
tbrToolBar.Buttons("OpenLogFile").Enabled = True
mnuCloseLog.Enabled = False
tbrToolBar.Buttons("CloseLogFile").Enabled = False
frmTerminal.Caption = "Visual Basic Terminal"
End Sub
Private Sub mnuDial_Click()
On Local Error Resume Next
Static Num As String
Num = "1-206-936-6735" ' This is the MSDN 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 MSComm1.PortOpen Then
mnuOpen_Click
If Err Then Exit Sub
End If
' Enable hang up button and menu item
mnuHangUp.Enabled = True
tbrToolBar.Buttons("HangUpPhone").Enabled = True
' Dial the number.
MSComm1.Output = "ATDT" & Num & vbCrLf
' Start the port timer
StartTiming
End Sub
' Toggle the DTREnabled property.
Private Sub mnuDTREnable_Click()
' Toggle DTREnable property
MSComm1.DTREnable = Not MSComm1.DTREnable
mnuDTREnable.Checked = MSComm1.DTREnable
End Sub
Private Sub mnuFileExit_Click()
' Use Form_Unload since it has code to check for unsent data and an open log file.
Form_Unload Ret
End Sub
' Toggle the DTREnable property to hang up the line.
Private Sub mnuHangup_Click()
On Error Resume Next
MSComm1.Output = "ATH" ' Send hangup string
Ret = MSComm1.DTREnable ' Save the current setting.
MSComm1.DTREnable = True ' Turn DTR on.
MSComm1.DTREnable = False ' Turn DTR off.
MSComm1.DTREnable = Ret ' Restore the old setting.
mnuHangUp.Enabled = False
tbrToolBar.Buttons("HangUpPhone").Enabled = False
' If port is actually still open, then close it
If MSComm1.PortOpen Then MSComm1.PortOpen = False
' Notify user of error
If Err Then MsgBox Error$, 48
mnuSendText.Enabled = False
tbrToolBar.Buttons("TransmitTextFile").Enabled = False
mnuHangUp.Enabled = False
tbrToolBar.Buttons("HangUpPhone").Enabled = False
mnuDial.Enabled = True
tbrToolBar.Buttons("DialPhoneNumber").Enabled = True
sbrStatus.Panels("Settings").Text = "Settings: "
' Turn off indicator light and uncheck open menu
mnuOpen.Checked = False
imgNotConnected.ZOrder
' Stop the port timer
StopTiming
sbrStatus.Panels("Status").Text = "Status: "
On Error GoTo 0
End Sub
' Display the value of the CDHolding property.
Private Sub mnuHCD_Click()
If MSComm1.CDHolding Then
Temp = "True"
Else
Temp = "False"
End If
MsgBox "CDHolding = " + Temp
End Sub
' Display the value of the CTSHolding property.
Private Sub mnuHCTS_Click()
If MSComm1.CTSHolding Then
Temp = "True"
Else
Temp = "False"
End If
MsgBox "CTSHolding = " + Temp
End Sub
' Display the value of the DSRHolding property.
Private Sub mnuHDSR_Click()
If MSComm1.DSRHolding Then
Temp = "True"
Else
Temp = "False"
End If
MsgBox "DSRHolding = " + Temp
End Sub
' This procedure sets the InputLen property, which determines how
' many bytes of data are read each time Input is used
' to retreive data from the input buffer.
' Setting InputLen to 0 specifies that
' the entire contents of the buffer should be read.
Private Sub mnuInputLen_Click()
On Error Resume Next
Temp = InputBox$("Enter New InputLen:", "InputLen", Str$(MSComm1.InputLen))
If Len(Temp) Then
MSComm1.InputLen = Val(Temp)
If Err Then MsgBox Error$, 48
End If
End Sub
Private Sub mnuProperties_Click()
' Show the CommPort properties form
frmProperties.Show vbModal
End Sub
' Toggles the state of the port (open or closed).
Private Sub mnuOpen_Click()
On Error Resume Next
Dim OpenFlag
MSComm1.PortOpen = Not MSComm1.PortOpen
If Err Then MsgBox Error$, 48
OpenFlag = MSComm1.PortOpen
mnuOpen.Checked = OpenFlag
mnuSendText.Enabled = OpenFlag
tbrToolBar.Buttons("TransmitTextFile").Enabled = OpenFlag
If MSComm1.PortOpen Then
' Enable dial button and menu item
mnuDial.Enabled = True
tbrToolBar.Buttons("DialPhoneNumber").Enabled = True
' Enable hang up button and menu item
mnuHangUp.Enabled = True
tbrToolBar.Buttons("HangUpPhone").Enabled = True
imgConnected.ZOrder
sbrStatus.Panels("Settings").Text = "Settings: " & MSComm1.Settings
StartTiming
Else
' Enable dial button and menu item
mnuDial.Enabled = True
tbrToolBar.Buttons("DialPhoneNumber").Enabled = True
' Disable hang up button and menu item
mnuHangUp.Enabled = False
tbrToolBar.Buttons("HangUpPhone").Enabled = False
imgNotConnected.ZOrder
sbrStatus.Panels("Settings").Text = "Settings: "
StopTiming
End If
End Sub
Private Sub mnuOpenLog_Click()
Dim replace
On Error Resume Next
OpenLog.Flags = cdlOFNHideReadOnly Or cdlOFNExplorer
OpenLog.CancelError = True
' Get the log filename from the user.
OpenLog.DialogTitle = "Open Communications Log File"
OpenLog.Filter = "Log Files (*.LOG)|*.log|All Files (*.*)|*.*"
Do
OpenLog.FileName = ""
OpenLog.ShowOpen
If Err = cdlCancel Then Exit Sub
Temp = OpenLog.FileName
' If the file already exists, ask if the user wants to overwrite the file or add to it.
Ret = Len(Dir$(Temp))
If Err Then
MsgBox Error$, 48
Exit Sub
End If
If Ret Then
replace = MsgBox("Replace existing file - " + Temp + "?", 35)
Else
replace = 0
End If
Loop While replace = 2
' User clicked the Yes button, so delete the file.
If replace = 6 Then
Kill Temp
If Err Then
MsgBox Error$, 48
Exit Sub
End If
End If
' Open the log file.
hLogFile = FreeFile
Open Temp For Binary Access Write As hLogFile
If Err Then
MsgBox Error$, 48
Close hLogFile
hLogFile = 0
Exit Sub
Else
' Go to the end of the file so that new data can be appended.
Seek hLogFile, LOF(hLogFile) + 1
End If
frmTerminal.Caption = "Visual Basic Terminal - " + OpenLog.FileTitle
mnuOpenLog.Enabled = False
tbrToolBar.Buttons("OpenLogFile").Enabled = False
mnuCloseLog.Enabled = True
tbrToolBar.Buttons("CloseLogFile").Enabled = True
End Sub
' This procedure sets the ParityReplace property, which holds the
' character that will replace any incorrect characters
' that are received because of a parity error.
Private Sub mnuParRep_Click()
On Error Resume Next
Temp = InputBox$("Enter Replace Character", "ParityReplace", frmTerminal.MSComm1.ParityReplace)
frmTerminal.MSComm1.ParityReplace = Left$(Temp, 1)
If Err Then MsgBox Error$, 48
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -