como leer datos de una balanza conectada al puerto serie desde visual basic
He desarrollado una pequeña aplicacion en visual basic 6, a traves del control MSComm, para leer los datos que se encuentran en un display de una balanza que esta conectada al puerto serie de la cmputadora, y bueno hasta la fecha no he tenido exito. He consultado varia informacion del manejo del puerto serie con visual basic, usando el control MSComm, sin embargo, he programado una pequeña aplicacion considerando todos aquellos comentarios que he leeido en varios links de Internet y aun no he podido conseguir tomar los datos del display de la balanza y llevarlos a un cuadro de texto en mi aplicacion.
Si alguien tiene algun tip o sugerencia que me pueda orientar a resolver mi problema, por favor escriban una nota en este foro, me seria de mucha ayuda.
y si alguien quiere que le mande mi programita para que lo puedan analizar, con el que intento de leer el puerto serie, mandenme una nota a mi correo.
De antemano gracias por leer mi nota, se que a otros colegas a qui en la red, tambien les ayudara a resolver algunas dudas.
Gracias y Un saludo.
Recibi tu nota, y bueno aqui te envio mi codigo. Lo puse en un archivo Prueba.ZIP.
Si tienes oportunidad de revisarlo y sugerirme cuales podrian ser los errores o declaraciones que faltan, para que pueda recibir los datos del puerto serie.
Tambien te preguntaba si necesito algun driver o controlador del equipo LabWave 9000, para instalarlo en la computadora y que esta la pueda reconocer.
esta es una seccion del programa en el que configuro el puerto:
Private Sub LoadSettings()
On Error GoTo CommPortErr
'Objetos locales
Dim Settings As String
Dim CommPort As String
Dim Handshaking As String
Dim Offset As Integer
Dim Buffer As Variant
Dim strLOC_ErrorMessage As String
'-+--------------------------------------+-
' PROPIEDAD Settings
'-+--------------------------------------+-
'Obtengo del Regedit los valores de la propiedad Settings
Settings = GetSetting("LabWave9000", "Properties", "Settings", "")
If Settings <> "" Then
Me.commLabWave.Settings = Settings
If Err Then
MsgBox "ERROR AL TRATAR DE ASIGNAR LA CONFIGURACION DEL PUERTO." & _
vbCrLf & Err.Number & _
vbCrLf & Err.Source & _
vbCrLf & Err.Description, vbCritical, "Settings"
Exit Sub
End If
End If
' En todos los casos, el componente más a la derecha de Settings
' será un solo carácter, excepto cuando haya 1,5 bits de parada.
If InStr(Settings, ".") > 0 Then
Offset = 2
Else
Offset = 0
End If
'-+--------------------------------------+-
' PROPIEDAD Commport
'-+--------------------------------------+-
'Obtengo del Regedit los valores de la propiedad CommPort
CommPort = GetSetting("LabWave9000", "Properties", "CommPort", "")
If CommPort <> "" Then
Me.commLabWave.CommPort = CommPort
If Err Then
MsgBox "ERROR AL TRATAR DE ASIGNAR LA CONFIGURACION DEL PUERTO." & _
vbCrLf & Err.Number & _
vbCrLf & Err.Source & _
vbCrLf & Err.Description, vbCritical, "Commport"
Exit Sub
End If
End If
'-+-------------------------------------------------------------------------+-
' PROTOCOLO DE CONEXION, PROPIEDAD Handshaking
'-+-------------------------------------------------------------------------+-
'Obtengo del Regedit los valores de la propiedad Handshaking
Handshaking = GetSetting("LabWave9000", "Properties", "Handshaking", "")
'La propiedad Handshaking puede tomar los siguientes valores:
' Opción Valor Descripción
'-------------------------------------------------------------------------------------
' comNone 0 Sin protocolo(predeterminado)
' comXOnXOff 1 Protocolo XOn/XOff
' comRTS 2 Protocolo RTS/CTS (Petición para emitir/Listo para emitir)
' comRTSXOnXOff 3 Ambos protocolos RTS/CTS y XOn/XOff
'-------------------------------------------------------------------------------------
If Handshaking <> "" Then
Me.commLabWave.Handshaking = Handshaking
If Err Then
MsgBox "ERROR AL TRATAR DE ASIGNAR LA CONFIGURACION DEL PUERTO." & _
vbCrLf & Err.Number & _
vbCrLf & Err.Source & _
vbCrLf & Err.Description, vbCritical, "Handshaking"
Exit Sub
End If
End If
'-+-----------------------------------------------------+-
' APERTURA DEL PUERTO
'-+-----------------------------------------------------+-
With Me.commLabWave
'Tamaño del Búfer de Recepción
'Obtengo de el Regedit el Tamaño de buffer de recepción
.InBufferSize = GetSetting("LabWave9000", "Properties", "InBufferSize", "")
'Necesario para interceptar el evento comEvReceive, aunque en este formulario _
no ocupo el evento OnComm()
.RThreshold = 1
'Necesario para interceptar el evento comEvSend
.SThreshold = 1
'Indicar al control que lea todo el buffer al usar Input
.InputLen = 0
'Los datos se recuperan como texto
.InputMode = comInputModeText
'No Borro el contenido del buffer para leer lo que tiene
'.InBufferCount = 0
'Necesario para recibir los datos
.RTSEnable = True 'Determina el estado de la linea Equipo de datos _
preparado (DTR).
.DTREnable = True 'Determina el estado de la linea Equipo de datos _
preparado (DSR).
'Determina si se transfieren caracteres nulos desde el puerto _
al búfer de recepción
.NullDiscard = True
'Establece y devuelve el carácter que reemplaza a un carácter _
no válido en el flujo de datos cuando se produce un error de paridad
.ParityReplace = "?"
' Recuperar datos del puerto por el Método de sondeo
If Not .PortOpen Then
.PortOpen = True
End If
'Buffer variable de Tipo Variant. Tomo los datos del puerto
Buffer = .Input
Me.txtBuffer.Text = txtBuffer.Text & Buffer
'MsgBox "DATOS TOMADOS DEL BUFFER: " & Buffer, vbInformation, "LW Terminal"
If .PortOpen Then
.PortOpen = False 'Cerrar el puerto de comunicaciones
End If
End With
'-+-----------------------------------------------------+-
CommPortErr:
If Err.Number <> 0 Then
Select Case Err.Number
Case 380: strLOC_ErrorMessage = "VALOR DE LA PROPIEDAD NO VALIDO"
Case 383: strLOC_ErrorMessage = "PROPIEDAD DE SOLO LECTURA"
Case 394: strLOC_ErrorMessage = "PROPIEDAD DE SOLO LECTURA"
Case 8000: strLOC_ErrorMessage = "OPERACION NO VALIDA MIENTRAS ESTE ABIERTO EL PUERTO"
Case 8001: strLOC_ErrorMessage = "EL VALOR DE TIEMPO DE ESPERA DEBE SER MAYOR A CERO"
Case 8002: strLOC_ErrorMessage = "NUMERO DE PUERTO INVALIDO: Comm" & CommPort
Case 8003: strLOC_ErrorMessage = "PROPIEDAD DISPONIBLE SOLO EN TIEMPO DE EJECUCION"
Case 8004: strLOC_ErrorMessage = "PROPIEDAD DE SOLO LECTURA EN TIEMPO DE EJECUCION"
Case 8005: strLOC_ErrorMessage = "EL PUERTO: Comm" & CommPort & " YA SE ENCUENTRA ABIERTO." & vbCrLf & "ES POSIBLE QUE ESTE SIENDO UTILIZADO POR OTRA APLICACION"
Case 8006: strLOC_ErrorMessage = "EL IDENTIFICADOR DEL DISPOSITIVO NO ES VALIDO O NO ESTA PERMITIDO"
Case 8007: strLOC_ErrorMessage = "LA VELOCIDAD EN BAUDIOS DEL DISPOSITIVO NO ESTA PERMITIDA"
Case 8008: strLOC_ErrorMessage = "EL TAMAÑO EN BYTES ESPECIFICADO NO ES VALIDO"
Case 8009: strLOC_ErrorMessage = "LOS PARAMETROS PREDETERMINADOS SON INCORRECTOS"
Case 8010: strLOC_ErrorMessage = "EL HARDWARE NO ESTA DISPONIBLE (ES POSIBLE QUE ESTE BLOQUEADO POR OTRO DISPOSITIVO)"
Case 8011: strLOC_ErrorMessage = "LA FUNCION NO PUEDE ASIGNAR LAS COLAS"
Case 8012: strLOC_ErrorMessage = "EL DISPOSITIVO NO ESTA ABIERTO"
Case 8013: strLOC_ErrorMessage = "EL DISPOSITIVO YA ESTA ABIERTO"
Case 8014: strLOC_ErrorMessage = "NO SE PUEDE ACTIVAR LA NOTIFICACION DE COMUNICACION"
Case 8015: strLOC_ErrorMessage = "NO SE PUEDE ESTABLECER EL ESTADO DE COMUNICACION"
Case 8016: strLOC_ErrorMessage = "NO SE PUEDE ESTABLECER LA MASCARA DE EVENTOS DE COMUNICACION"
Case 8018: strLOC_ErrorMessage = "OPERACION VALIDA SOLO CUANDO EL PUERTO ESTA ABIERTO"
Case 8019: strLOC_ErrorMessage = "DISPOSITIVO OCUPADO"
Case 8020: strLOC_ErrorMessage = "ERROR AL LEER EL DISPOSITIVO DE COMUNICACION"
Case 8021: strLOC_ErrorMessage = "ERROR INTERNO AL RECUPERAR EL BLOQUE DE CONTROL DE DISPOSITIVOS PARA EL PUERTO"
Case Else
strLOC_ErrorMessage = "Descripción: " & Err.Description & vbCrLf & _
"Numero: " & Err.Number & vbCrLf & _
"Fuente: " & Err.Source
End Select
MsgBox "SE HA GENERADO UN ERROR AL TRATAR DE ACCESAR A LOS DATOS A TRAVES DEL PUERTO" & vbCrLf & _
"ERROR GENERADO: " & strLOC_ErrorMessage & vbCrLf & _
"SE CERRARA LW Terminal, VUELVA A EJECUTARLA", vbCritical, "ERROR LW Terminal"
End
End If
End Sub
Si alguien tiene algun tip o sugerencia que me pueda orientar a resolver mi problema, por favor escriban una nota en este foro, me seria de mucha ayuda.
y si alguien quiere que le mande mi programita para que lo puedan analizar, con el que intento de leer el puerto serie, mandenme una nota a mi correo.
De antemano gracias por leer mi nota, se que a otros colegas a qui en la red, tambien les ayudara a resolver algunas dudas.
Gracias y Un saludo.
Recibi tu nota, y bueno aqui te envio mi codigo. Lo puse en un archivo Prueba.ZIP.
Si tienes oportunidad de revisarlo y sugerirme cuales podrian ser los errores o declaraciones que faltan, para que pueda recibir los datos del puerto serie.
Tambien te preguntaba si necesito algun driver o controlador del equipo LabWave 9000, para instalarlo en la computadora y que esta la pueda reconocer.
esta es una seccion del programa en el que configuro el puerto:
Private Sub LoadSettings()
On Error GoTo CommPortErr
'Objetos locales
Dim Settings As String
Dim CommPort As String
Dim Handshaking As String
Dim Offset As Integer
Dim Buffer As Variant
Dim strLOC_ErrorMessage As String
'-+--------------------------------------+-
' PROPIEDAD Settings
'-+--------------------------------------+-
'Obtengo del Regedit los valores de la propiedad Settings
Settings = GetSetting("LabWave9000", "Properties", "Settings", "")
If Settings <> "" Then
Me.commLabWave.Settings = Settings
If Err Then
MsgBox "ERROR AL TRATAR DE ASIGNAR LA CONFIGURACION DEL PUERTO." & _
vbCrLf & Err.Number & _
vbCrLf & Err.Source & _
vbCrLf & Err.Description, vbCritical, "Settings"
Exit Sub
End If
End If
' En todos los casos, el componente más a la derecha de Settings
' será un solo carácter, excepto cuando haya 1,5 bits de parada.
If InStr(Settings, ".") > 0 Then
Offset = 2
Else
Offset = 0
End If
'-+--------------------------------------+-
' PROPIEDAD Commport
'-+--------------------------------------+-
'Obtengo del Regedit los valores de la propiedad CommPort
CommPort = GetSetting("LabWave9000", "Properties", "CommPort", "")
If CommPort <> "" Then
Me.commLabWave.CommPort = CommPort
If Err Then
MsgBox "ERROR AL TRATAR DE ASIGNAR LA CONFIGURACION DEL PUERTO." & _
vbCrLf & Err.Number & _
vbCrLf & Err.Source & _
vbCrLf & Err.Description, vbCritical, "Commport"
Exit Sub
End If
End If
'-+-------------------------------------------------------------------------+-
' PROTOCOLO DE CONEXION, PROPIEDAD Handshaking
'-+-------------------------------------------------------------------------+-
'Obtengo del Regedit los valores de la propiedad Handshaking
Handshaking = GetSetting("LabWave9000", "Properties", "Handshaking", "")
'La propiedad Handshaking puede tomar los siguientes valores:
' Opción Valor Descripción
'-------------------------------------------------------------------------------------
' comNone 0 Sin protocolo(predeterminado)
' comXOnXOff 1 Protocolo XOn/XOff
' comRTS 2 Protocolo RTS/CTS (Petición para emitir/Listo para emitir)
' comRTSXOnXOff 3 Ambos protocolos RTS/CTS y XOn/XOff
'-------------------------------------------------------------------------------------
If Handshaking <> "" Then
Me.commLabWave.Handshaking = Handshaking
If Err Then
MsgBox "ERROR AL TRATAR DE ASIGNAR LA CONFIGURACION DEL PUERTO." & _
vbCrLf & Err.Number & _
vbCrLf & Err.Source & _
vbCrLf & Err.Description, vbCritical, "Handshaking"
Exit Sub
End If
End If
'-+-----------------------------------------------------+-
' APERTURA DEL PUERTO
'-+-----------------------------------------------------+-
With Me.commLabWave
'Tamaño del Búfer de Recepción
'Obtengo de el Regedit el Tamaño de buffer de recepción
.InBufferSize = GetSetting("LabWave9000", "Properties", "InBufferSize", "")
'Necesario para interceptar el evento comEvReceive, aunque en este formulario _
no ocupo el evento OnComm()
.RThreshold = 1
'Necesario para interceptar el evento comEvSend
.SThreshold = 1
'Indicar al control que lea todo el buffer al usar Input
.InputLen = 0
'Los datos se recuperan como texto
.InputMode = comInputModeText
'No Borro el contenido del buffer para leer lo que tiene
'.InBufferCount = 0
'Necesario para recibir los datos
.RTSEnable = True 'Determina el estado de la linea Equipo de datos _
preparado (DTR).
.DTREnable = True 'Determina el estado de la linea Equipo de datos _
preparado (DSR).
'Determina si se transfieren caracteres nulos desde el puerto _
al búfer de recepción
.NullDiscard = True
'Establece y devuelve el carácter que reemplaza a un carácter _
no válido en el flujo de datos cuando se produce un error de paridad
.ParityReplace = "?"
' Recuperar datos del puerto por el Método de sondeo
If Not .PortOpen Then
.PortOpen = True
End If
'Buffer variable de Tipo Variant. Tomo los datos del puerto
Buffer = .Input
Me.txtBuffer.Text = txtBuffer.Text & Buffer
'MsgBox "DATOS TOMADOS DEL BUFFER: " & Buffer, vbInformation, "LW Terminal"
If .PortOpen Then
.PortOpen = False 'Cerrar el puerto de comunicaciones
End If
End With
'-+-----------------------------------------------------+-
CommPortErr:
If Err.Number <> 0 Then
Select Case Err.Number
Case 380: strLOC_ErrorMessage = "VALOR DE LA PROPIEDAD NO VALIDO"
Case 383: strLOC_ErrorMessage = "PROPIEDAD DE SOLO LECTURA"
Case 394: strLOC_ErrorMessage = "PROPIEDAD DE SOLO LECTURA"
Case 8000: strLOC_ErrorMessage = "OPERACION NO VALIDA MIENTRAS ESTE ABIERTO EL PUERTO"
Case 8001: strLOC_ErrorMessage = "EL VALOR DE TIEMPO DE ESPERA DEBE SER MAYOR A CERO"
Case 8002: strLOC_ErrorMessage = "NUMERO DE PUERTO INVALIDO: Comm" & CommPort
Case 8003: strLOC_ErrorMessage = "PROPIEDAD DISPONIBLE SOLO EN TIEMPO DE EJECUCION"
Case 8004: strLOC_ErrorMessage = "PROPIEDAD DE SOLO LECTURA EN TIEMPO DE EJECUCION"
Case 8005: strLOC_ErrorMessage = "EL PUERTO: Comm" & CommPort & " YA SE ENCUENTRA ABIERTO." & vbCrLf & "ES POSIBLE QUE ESTE SIENDO UTILIZADO POR OTRA APLICACION"
Case 8006: strLOC_ErrorMessage = "EL IDENTIFICADOR DEL DISPOSITIVO NO ES VALIDO O NO ESTA PERMITIDO"
Case 8007: strLOC_ErrorMessage = "LA VELOCIDAD EN BAUDIOS DEL DISPOSITIVO NO ESTA PERMITIDA"
Case 8008: strLOC_ErrorMessage = "EL TAMAÑO EN BYTES ESPECIFICADO NO ES VALIDO"
Case 8009: strLOC_ErrorMessage = "LOS PARAMETROS PREDETERMINADOS SON INCORRECTOS"
Case 8010: strLOC_ErrorMessage = "EL HARDWARE NO ESTA DISPONIBLE (ES POSIBLE QUE ESTE BLOQUEADO POR OTRO DISPOSITIVO)"
Case 8011: strLOC_ErrorMessage = "LA FUNCION NO PUEDE ASIGNAR LAS COLAS"
Case 8012: strLOC_ErrorMessage = "EL DISPOSITIVO NO ESTA ABIERTO"
Case 8013: strLOC_ErrorMessage = "EL DISPOSITIVO YA ESTA ABIERTO"
Case 8014: strLOC_ErrorMessage = "NO SE PUEDE ACTIVAR LA NOTIFICACION DE COMUNICACION"
Case 8015: strLOC_ErrorMessage = "NO SE PUEDE ESTABLECER EL ESTADO DE COMUNICACION"
Case 8016: strLOC_ErrorMessage = "NO SE PUEDE ESTABLECER LA MASCARA DE EVENTOS DE COMUNICACION"
Case 8018: strLOC_ErrorMessage = "OPERACION VALIDA SOLO CUANDO EL PUERTO ESTA ABIERTO"
Case 8019: strLOC_ErrorMessage = "DISPOSITIVO OCUPADO"
Case 8020: strLOC_ErrorMessage = "ERROR AL LEER EL DISPOSITIVO DE COMUNICACION"
Case 8021: strLOC_ErrorMessage = "ERROR INTERNO AL RECUPERAR EL BLOQUE DE CONTROL DE DISPOSITIVOS PARA EL PUERTO"
Case Else
strLOC_ErrorMessage = "Descripción: " & Err.Description & vbCrLf & _
"Numero: " & Err.Number & vbCrLf & _
"Fuente: " & Err.Source
End Select
MsgBox "SE HA GENERADO UN ERROR AL TRATAR DE ACCESAR A LOS DATOS A TRAVES DEL PUERTO" & vbCrLf & _
"ERROR GENERADO: " & strLOC_ErrorMessage & vbCrLf & _
"SE CERRARA LW Terminal, VUELVA A EJECUTARLA", vbCritical, "ERROR LW Terminal"
End
End If
End Sub
