hola, gracias de antemano.
soy muy novata en visual basic.
estoy haciendo una aplicacion para poder recibir datos por el puerto serie.
como no tengo mucha idea me estoy basando en un programilla que encotre en el foro (no me acuerdo de que direccion lo saque). la cosa es que al compilarlo me da error en dos sitios.
si pulso el boton conectar y si pulso puerto. creo que el error es el mismo perono lo se , os pongo a continuacion el codigo para que me lo reviseis.
gracias de nuevo.
Option Explicit
Private WithEvents PuertoCom As MSComm
Private sPuerto As String
Private sBaudio As String
Private sParidad As String
Private sStop As String
Private sCaracter As String
'Tamaño de las colas de recepción y de transmisión
Const COLARX As Integer = 4096
Private Sub cmdConectar_Click()
If cmdConectar = True Then
AbrirConexion
'cmdDesconectar = False
'cmdGuardar = False
End If
End Sub
Private Sub cmdDesconectar_Click()
If cmdDesconectar = True Then
Terminar
CortarConexion
'cmdConectar = False
'cmdGuardar = False
End If
End Sub
Private Sub cmdGuardar_Click()
If cmdGuardar = True Then
'*GuardarDatos
cmdDesconectar = False
cmdConectar = False
End If
End Sub
Private Sub Form_Load()
' Crear un objeto MSComm
'Set PuertoCom = New MSComm
' Habilitar/Inhabilitar controles
mnuDesconectar.Enabled = False
Iniciar ' leer la configuración del registro de Windows
StatusBar1.SimpleText = "Preparado"
End Sub
Private Sub mnuConectar_Click()
AbrirConexion
End Sub
' RESPONDER A LOS EVENTOS GENERADOS EN EL PUERTO
' ----------------------------------------------
Private Sub PuertoCom_OnComm()
Dim sEvento As String, sError As String, sRecibida As String
' Controlar cada evento o error escribiendo
' código en cada caso
Select Case PuertoCom.CommEvent
' Eventos
Case comEvReceive
sEvento = "Recibido(s) " & PuertoCom.RThreshold & _
" carácter/caracteres."
' Leer caracteres del puerto
If LeerCarsPuerto(sRecibida) > 0 Then
txtRX.Text = txtRX.Text & sRecibida
End If
Case comEvSend
sEvento = "Hay SThreshold = " & PuertoCom.SThreshold & _
" carácter/caracteres en el búfer de transmisión."
' Errores
Case comBreak
sError = "Se ha recibido una interrupción."
Case comEventFrame
sError = "Error de trama."
Case comEventOverrun
sError = "Datos perdidos."
Case comEventRxOver
sError = "Desbordamiento del búfer de recepción."
Case comEventRxParity
sError = "Error de paridad."
Case comEventTxFull
sError = "Búfer de transmisión lleno."
End Select
If Not IsEmpty(sEvento) Then
StatusBar1.SimpleText = sEvento
ElseIf Not IsEmpty(sError) Then
Dim vr As VbMsgBoxResult
Beep
sError = sError & vbNewLine & "Aceptar para ignorar. " & _
"Cancelar para salir"
vr = MsgBox(sError, vbOKCancel + vbExclamation, App.Title)
If vr = vbCancel Then
' Cerrar el puerto
PuertoCom.PortOpen = False
mnuConexion.Enabled = True
mnuDesconectar.Enabled = False
End If
End If
End Sub
Private Function AbrirConexion() As Boolean
On Error Resume Next
With PuertoCom
' Cerrar el control si estuviera abierto
If PuertoCom = True Then
'aki es donde me marca un error
.PortOpen = False
' Especificar el puerto COM que se desea abrir
.CommPort = sPuerto ' número del puerto (1, 2, ...)
' Establecer el tamaño de las colas de recepción y transmisión
.InBufferSize = COLARX ' cola de recepción
' Limpiar las colas Rx
.InBufferCount = 0
.OutBufferCount = 0
' Establecer los parámetros de la comunicación
Dim sSettings As String
' Baudios, paridad, número de bits de datos y de parada
' Longitud del bit de paro:
sSettings = sBaudio & "," & Left(sParidad, 1) & "," & _
sCaracter & "," & sStop
.Settings = sSettings
' Caracteres que puede admitir el buffer de transmisión antes
' de que el control genere el evento OnComm.
' Su valor predeterminado es 0
.SThreshold = 1
' Caracteres que se van recibir antes de que el control genere
' el evento OnComm. Su valor predeterminado es 0.
.RThreshold = 1
' Abrir el puerto de comunicaciones
.PortOpen = True
End If
If PuertoCom = False Then
' Error al abrir el puerto (verifique la configuración)
Beep
MsgBox "Error: No se puede abrir el puerto COM" & _
sPuerto, vbOKOnly + vbCritical, App.Title
End If
If sStop > "1" Then
MsgBox _
"1 bit en cualquier longitud de carácter, o bien " & _
vbCrLf & "1.5 bits en longitud de carácter 5, y " & _
vbCrLf & "2 bits en longitud de carácter 6 a 8", _
vbOKOnly + vbInformation, App.Title
End If
AbrirConexion = False
End With
' El puerto se abrió con éxito
AbrirConexion = True
StatusBar1.SimpleText = "Puerto de comunicaciones abierto"
' Habilitar/Inhabilitar órdenes de ls menús
mnuConectar.Enabled = False
mnuDesconectar.Enabled = True
End Function
Private Function LeerCarsPuerto(ByRef sRecibida As String) As Long
sRecibida = PuertoCom.Input
LeerCarsPuerto = Len(sRecibida)
End Function
Private Function CortarConexion() As Boolean
If mnuDesconectar.Enabled = True Then
Dim bTiempoSobrepasado As Boolean, Tiempo As Long
' Establecer un periodo de 10 segundos a partir de la hora
' actual antes de cerrar el puerto, por seguridad
bTiempoSobrepasado = False
Tiempo = Now
StatusBar1.SimpleText = "Cerrando la conexión..."
While PuertoCom.OutBufferCount > 0
' Permitir procesar mensajes pendientes
DoEvents
If DateDiff("s", Now, Tiempo) > 10 Or _
bTiempoSobrepasado = True Then
Dim vr As VbMsgBoxResult
vr = MsgBox("Datos no enviados", vbAbortRetryIgnore, _
App.Title)
Select Case vr
' Intentar enviar los datos durante otros 10 segundos
Case vbRetry
Tiempo = Now
' Ignorar el tiempo límite
Case vbIgnore
bTiempoSobrepasado = True
Case vbAbort
StatusBar1.SimpleText = ""
CortarConexion = False
Exit Function
End Select
End If
Wend
PuertoCom.PortOpen = False
mnuConectar.Enabled = True
mnuDesconectar.Enabled = False
End If
StatusBar1.SimpleText = "Conexión concluida"
CortarConexion = True
End Function
Private Sub mnuDesconectar_Click()
Terminar
CortarConexion
End Sub
Private Sub mnuGuardar_Click()
'*GuardarDatos
End Sub
Private Sub mnuPuerto_Click()
If PuertoCom.PortOpen = True Then
'aki esta el otro error
MsgBox "Cierre primero la conexión"
Exit Sub
End If
' Visualizar en los controles los parámetros de comunicación
' actuales. Inicialmente fueron recuperados del registro
frmConfiguracion.sPuerto = sPuerto
frmConfiguracion.sBaudio = sBaudio
frmConfiguracion.sParidad = sParidad
frmConfiguracion.sCaracter = sCaracter
frmConfiguracion.sStop = sStop
' Visualizar el formulario Configuración
frmConfiguracion.Show vbModal, Me
' Si se pulsó el botón Aceptar ...
If frmConfiguracion.bDatosVálidos = True Then
' Asignar los nuevos valores a las variables correspondientes
sPuerto = frmConfiguracion.sPuerto
sBaudio = frmConfiguracion.sBaudio
sParidad = frmConfiguracion.sParidad
sCaracter = frmConfiguracion.sCaracter
sStop = frmConfiguracion.sStop
' Descargar el formulario
Unload frmConfiguracion
' Establecer la conexión con los parámetros establecidos
End If
End Sub
Private Sub mnuCerrar_Click()
End
End Sub
Private Sub mnuAcercade_Click()
frmAcercaDe.Show vbModal, Me
End Sub
Private Sub Iniciar()
'se verifica que los datos obtenidos sean buenos
sPuerto = GetSetting(App.Title, "MSComm", "Puerto", "1")
sBaudio = GetSetting(App.Title, "MSComm", "Baudio", "9600")
sStop = GetSetting(App.Title, "MSComm", "Stop", "1")
sParidad = GetSetting(App.Title, "MSComm", "Paridad", "None - Ninguna")
sCaracter = GetSetting(App.Title, "MSComm", "Caracter", "8")
End Sub
Private Sub Terminar()
SaveSetting App.Title, "MSComm", "Puerto", sPuerto
SaveSetting App.Title, "MSComm", "Baudio", sBaudio
SaveSetting App.Title, "MSComm", "Stop", sStop
SaveSetting App.Title, "MSComm", "Paridad", sParidad
SaveSetting App.Title, "MSComm", "Caracter", sCaracter
End Sub
