'////////////////////////////////////////
'/Agregar los siguientes controles al proyecto:
'////////////////////////////////////////
'/CommandButton1 --name= cmdConectar
'/CommandButton2 --name= cmdEnviar
'/ComboBox1 --name = cmbSel
'/MSComm -- name = Puerto <---Agregar componente (ctrl+t): Microsoft Comm Control 6.0
'/TextBox --name = txtEnviar
'/Timer1 -- name: Timer1
'/Label -- name: lblMostrar
'////////////////////////////////////////'//////////////////////////////////////////
Dim TextOut, TextIn As String
Private Sub Form_Load()
cmdConectar.Caption = "Conectar"
cmdenviar.Caption = "Enviar"
Timer1.Enabled = False
Timer1.Interval = 1
'Lista los puertos y comprueba su disponibilidad
cmbSel.Clear
Call GetInstalledCOMPorts(cmbSel)
cmbSel.ListIndex = 0
End Sub
Private Sub cmdConectar_Click()
On Error GoTo EvitarError
If cmdConectar.Caption = "Conectar" Then
puerto.CommPort = Val(cmbSel.ListIndex + 1)
puerto.PortOpen = True
cmdenviar.Visible = True
Timer1.Enabled = True
cmdConectar.Caption = "Desconectar"
End If
' procedimiento para desconectar puerto
If cmdConectar.Caption = "Desconectar" Then
Timer1.Enabled = False
cmdenviar.Visible = False
puerto.PortOpen = False
cmdConectar.Caption = "Conectar"
End If
EvitarError:
If Err Then
MsgBox "Puerto no disponible", vbExclamation, "Atención"
End If
End Sub
Private Sub cmdEnviar_Click()
On Error GoTo EvitarError
TextOut = txtEnviar.Text
puerto.Output = TextOut
EvitarError:
If Err Then
MsgBox "Puerto " & Left(cmbSel.List(cmbSel.ListIndex), 4) & _
" no conectado", vbExclamation, "Atención"
End If
End Sub
Private Function GetInstalledCOMPorts(ByVal lstCmb As ComboBox) As Long
Dim Port As Long
For Port = 1 To 16
If COMCheckPort(Port) Then
lstCmb.AddItem "COM" & Port & " disponible"
Else
lstCmb.AddItem "COM" & Port & " (no disponible o no hay ningún puerto)"
End If
Next
End Function
Private Function COMCheckPort(ByVal NumPort As Long) As Boolean
On Error GoTo EvitarError
puerto.CommPort = NumPort
If puerto.PortOpen = True Then
COMCheckPort = False
Exit Function
Else
'Test the port by opening and closing it
puerto.PortOpen = True
puerto.PortOpen = False
COMCheckPort = True
Exit Function
End If
EvitarError:
COMCheckPort = False
End Function
Private Sub Timer1_Timer()
TextIn = puerto.Input
If TextIn <> vbNullString Then
lblMostrar.Caption = TextIn
End If
End Sub