Back  | Code Snippets |  [Bill's Home]

RS-232 for VB

RS-232 ZIP [EXE]

The code for the client form is:


Option Explicit


Dim Ret As Integer ' Scratch integer.
Dim Temp As String ' Scratch string.

Private Sub Form_Load()
Dim CommPort As String, Handshaking As String, Settings As String

On Error Resume Next

1 AOL Time Warner
2 Microsoft Sites
3 Yahoo!
4 Lycos
5 Excite Network
6 The Human Internet
7 NBC Internet Sites
8 Walt Disney Internet
9 Infospace Infrastructure
10 Amazon

[Link]

Most accessed WWW sites, May 2001 (1-10)

' Set the default color for the terminal
txtTerm.SelLength = Len(txtTerm)
txtTerm.SelText = ""
txtTerm.ForeColor = vbBlue

' Set Title
App.Title = "Visual Basic Terminal"

' 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


11 eBay
12 CNET Networks
13 AltaVista Network
14 X10.COM
15 Ask Jeeves
16 eUniverse Network
17 Real.com Network
18 Viacom Online
19 Napster Digital
20 GOOGLE.COM

[Link]


Most accessed WWW sites, May 2001 (11-20)

Private Sub Form_Unload(Cancel As Integer)
Dim Counter As Long

If MSComm1.PortOpen Then
MSComm1.PortOpen = 0
End If

End
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

' 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

1 Yahoo!
2 MSN
3 iWon
4 Excite
5 AOL.com
6 Netscape
7 Raging Bull
8 eBay
9 flipside.com
10 MSNBC


[Link]
Best WWW sites, May 2001

' 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

If MSComm1.PortOpen Then
sbrStatus.Panels("Settings").Text = "Settings: " & MSComm1.Settings
Else
sbrStatus.Panels("Settings").Text = "Settings: "
End If

End Sub

' This procedure sets the RThreshold property, which determines
' how many bytes can arrive at the receive buffer before the OnComm
' event is triggered and the CommEvent property is set to comEvReceive.
Private Sub mnuRThreshold_Click()
On Error Resume Next

Temp = InputBox$("Enter New RThreshold:", "RThreshold", Str$(MSComm1.RThreshold))
If Len(Temp) Then
MSComm1.RThreshold = Val(Temp)
If Err Then MsgBox Error$, 48
End If

End Sub


' The OnComm event is used for trapping communications events and errors.
Private Static Sub MSComm1_OnComm()
Dim EVMsg$
Dim ERMsg$

' Branch according to the CommEvent property.
Select Case MSComm1.CommEvent
' Event messages.
Case comEvReceive
Dim Buffer As Variant
Buffer = MSComm1.Input
receive.Text = receive.Text + StrConv(Buffer, vbUnicode)

Case comEvSend
Case comEvCTS
EVMsg$ = "Change in CTS Detected"
Case comEvDSR
EVMsg$ = "Change in DSR Detected"
Case comEvCD
EVMsg$ = "Change in CD Detected"
Case comEvRing
EVMsg$ = "The Phone is Ringing"
Case comEvEOF
EVMsg$ = "End of File Detected"

' Error messages.
Case comBreak
ERMsg$ = "Break Received"
Case comCDTO
ERMsg$ = "Carrier Detect Timeout"
Case comCTSTO
ERMsg$ = "CTS Timeout"
Case comDCB
ERMsg$ = "Error retrieving DCB"
Case comDSRTO
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

If Len(EVMsg$) Then
' Display event messages in the status bar.
sbrStatus.Panels("Status").Text = "Status: " & EVMsg$

ElseIf Len(ERMsg$) Then
' Display event messages in the status bar.
sbrStatus.Panels("Status").Text = "Status: " & ERMsg$

' Display error messages in an alert message box.
Ret = MsgBox(ERMsg$, 1, "Click Cancel to quit, OK to ignore.")

' If the user clicks Cancel (2)...
If Ret = 2 Then
MSComm1.PortOpen = False ' Close the port and quit.
End If

End If
End Sub


' This procedure sets the SThreshold property, which determines
' how many characters (at most) have to be waiting
' in the output buffer before the CommEvent property
' is set to comEvSend and the OnComm event is triggered.
Private Sub mnuSThreshold_Click()
On Error Resume Next

Temp = InputBox$("Enter New SThreshold Value", "SThreshold", Str$(MSComm1.SThreshold))
If Len(Temp) Then
MSComm1.SThreshold = Val(Temp)
If Err Then MsgBox Error$, 48
End If
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 MSComm1.PortOpen Then
' Send the keystroke to the port.
MSComm1.Output = Chr$(KeyAscii)

txtTerm.SelStart = Len(txtTerm)

End If

End Sub