Visual Basic 6.0 Sample Serial Communications Program Listing

'Serial Port Program
'By David A. Ward February 2000
'The following files are needed for this application:
'   for the Microsoft Comm Control 6.0 for MSComm1
'      MSCOMM32.OCX
'   for the Microsoft Common Dialog Control 6.0 for Comdia.ShowSave
'      COMDLG32.OCX
'   for the Microsoft Windows Common Controls for ProgressBar1
'      MSCOMCTL.OCX

Option Explicit
Dim X As String
'Set up serial port
Private Sub Form_Load()
    MousePointer = 0
    MSComm1.CommPort = 1
    MSComm1.Settings = (Combo1.Text + "," + "n" + "," + Combo3.Text + "," + Combo4.Text)
    MSComm1.InputLen = 0
    MSComm1.PortOpen = True
    MSComm1.RThreshold = 1
    Option1 = True   'start program in conversation mode
    Option2 = False  'disable block send mode
End Sub
'Close com1 when exiting the program
Private Sub Form_Unload(Cancel As Integer)
    MSComm1.PortOpen = False
End Sub
'Send a block of text from the Send_box when the block send button is clicked
Private Sub cmdSend_Click()
    Dim i, SendLen As Integer
    SendLen = Len(Send_box.Text)
    For i = 1 To SendLen
      Do While MSComm1.OutBufferCount > 500
        DoEvents
      Loop
      MSComm1.Output = Mid$(Send_box.Text, i, 1)
      ProgressBar1.Value = (i / SendLen) * 100
      ProgressBar1.Refresh
    Next i
    ProgressBar1.Value = 0
End Sub
'Clear the Send_box and the Receive_box text boxes
Private Sub cmdClear_Click()
    Send_box.Text = ""
    Receive_box.Text = ""
End Sub
'Receive a file
Private Sub cmdDownLoad_Click()
     Dim saved_file As String
     ComDia.ShowSave
     saved_file = ComDia.FileName
     On Error GoTo out
     If Len(Dir(saved_file)) > 0 Then
        If MsgBox("Replace existing file?", vbYesNo, "Overwrite Confirmation") = vbNo Then Exit Sub
     End If
     Open saved_file For Output As 1
     On Error GoTo out
     Print #1, Receive_box.Text
     Close #1
out:
End Sub
'Send a file
Private Sub cmdUpLoad_Click()
    Dim saved_file, Data As String
    Dim i, SendLen As Integer
    ComDia.ShowOpen
    On Error GoTo out
    saved_file = ComDia.FileName
    MousePointer = 13
    Open saved_file For Input As 1
    On Error GoTo out
    Do While Not EOF(1)
        Input #1, Data
        Send_box.Text = Send_box.Text + Data + Chr$(13) + Chr$(10)
    Loop
    Close #1
    Send_box.Refresh
    SendLen = Len(Send_box.Text)
    For i = 1 To SendLen
      Do While MSComm1.OutBufferCount > 500
        DoEvents
      Loop
      MSComm1.Output = Mid$(Send_box.Text, i, 1)
      ProgressBar1.Value = (i / SendLen) * 100
      ProgressBar1.Refresh
    Next i
    ProgressBar1.Value = 0
out:
MousePointer = 0
End Sub
'Baud rate
Private Sub Combo1_Click()
    Call Port_Settings
End Sub
'Parity
Private Sub Combo2_Click()
    Call Port_Settings
End Sub
'Number if data bits
Private Sub Combo3_Click()
    Call Port_Settings
End Sub
'Number of stop bits
Private Sub Combo4_Click()
    Call Port_Settings
End Sub
'Print serial data received to Receive_box
Private Sub MSComm1_OnComm()
  Select Case MSComm1.CommEvent
    Case comEventRxOver
      MsgBox ("Receive buffer overflow")
    Case comEventTxFull
      MsgBox ("Send buffer overflow")
    Case comEventOverrun
      MsgBox ("Data Lost")
    Case comEvReceive
      X = MSComm1.Input
      Receive_box.Text = Receive_box.Text + X
  End Select
End Sub
'Change the serial port settings whenever a change is made in
'any of the combo boxes
Public Sub Port_Settings()
Dim Parity As String
Select Case Combo2.Text
        Case "None"
            Parity = "n"
        Case "Odd"
            Parity = "o"
        Case "Even"
            Parity = "e"
        End Select
    MSComm1.Settings = (Combo1.Text + "," + Parity + "," + Combo3.Text + "," + Combo4.Text)
End Sub
'Exit the program
Private Sub cmdExit_Click()
    End
End Sub
'Conversation mode, disable the block send mode option button
Private Sub Option1_Click()
    cmdSend.Enabled = False
 End Sub
'Block send mode, disable the conversation mode option button
Private Sub Option2_Click()
    cmdSend.Enabled = True
End Sub
'Send out each key stroke if the conversation mode is checked
Private Sub Send_box_KeyPress(KeyAscii As Integer)
If Option1 = True Then
        If (KeyAscii) = 13 Then
        MSComm1.Output = Chr$(13)   'carriage return
        MSComm1.Output = Chr$(10)   'line feed
        Else
        MSComm1.Output = Chr$(KeyAscii)
        End If
End If
End Sub