Private Sub evento()
Dim Lee As String
Dim rtnstr As String
Dim cad As String
rtnstr = "0"
Select Case MSComm1.CommEvent
Case comBreak " Se ha recibido una interrupción.
"Case comEventCDTO " Tiempo de espera CD (RLSD).
Case comEventCTSTO " Tiempo de espera CTS.
Case comEventDSRTO " Tiempo de espera DSR.
Case comEventFrame " Error de trama
Case comEventOverrun " Datos perdidos.
Case comEventRxOver " Desbordamiento del búfer de recepción.
Case comEventRxParity " Error de paridad.
Case comEventTxFull " Búfer de transmisión lleno.
Case comEventDCB " Error inesperado al recibir DCB]
Case comEvCD " Cambio en la línea CD.
Case comEvCTS " Cambio en la línea CTS.
Case comEvDSR " Cambio en la línea DSR.
Case comEvReceive " Recibido nº RThreshold
If MSComm1.InBufferCount > 0 Then
Lee$ = Lee$ + MSComm1.Input "dato leido del puerto
lcodigotarjeta.Caption = Lee$ "muestra el dato
End If
MSComm1.RThreshold = 3 "trigger cuando al menos un caracter está en el buffer
Case comEvSend " Hay un número SThreshold de caracteres en el búfer de transmisión.
While MSComm1.InBufferCount <> 0
recv_wk = frmTransRec.MSComm1.Input
strRecvBuf = strRecvBuf + recv_wk
ip = InStr(strRecvBuf, CRSCR)
While ip <> 0
recv = Left(strRecvBuf, ip + 1)
strRecvBuf = Mid(strRecvBuf, ip + 1)
ip = InStr(strRecvBuf, CRSCR)
Wend
Wend
Case comEvEOF " Se ha encontrado un carácter EOF en la entrada
End Select
End Sub
Private Sub lcodigotarjeta_change()
proceso
grabar
End Sub
Private Sub MSComm1_OnComm()
MSComm1.Settings = "9600,N,8,1"
End Sub
Private Sub Timer1_Timer()
Dim InString As String
Dummy = DoEvents()
If MSComm1.InBufferCount > 0 Then
If MSComm1.Input = "á" Then
lectura
""" InString$ = InString$ + MSComm1.Input
""" lcodigotarjeta.Caption = InString$
""" MSComm1.InBufferCount = 0
""" lectura
" If t.Text = "á" Then
" lectura
"
" MSComm1.Output = Chr$(ACK)
" "Else
" "lcodigotarjeta.Caption = InString$
" "presentar_viajes
End If
" Else
MSComm1.RThreshold = 3
End If
End Sub
Private Sub lectura()
Dim cadena As String
Dim TextoSalida As String
Dim BCC As Integer
Dim bcc1 As String
CMD = 82
op = 0
datos = 13
" Envía un comando para la lectura
BCC = (STX) Xor (CMD) Xor (datos) Xor (op) Xor (ETX) "enviar caracteres ascii
MSComm1.Output = Chr$(STX) & Chr$(82) & Chr$(13) & Chr$(0) & Chr$(ETX) & Chr$(94)
MSComm1.RThreshold = 1 "trigger cuando al menos un caracter está en el buffer
MSComm1.SThreshold = 3
Dummy = DoEvents()
If MSComm1.InBufferCount > 0 Then
" If MSComm1.Input = "á" Then
cadena$ = cadena$ + MSComm1.Input
lcodigotarjeta.Text = cadena$
MSComm1.InBufferCount = 0
End If
End Sub
Private Sub grabar()
Dim contador As Integer
Set registro = New ADODB.Recordset
registro.Open "select * from tarjeta", conexion, adOpenDynamic, adLockOptimistic
With registro
.AddNew
!cod_tarjeta = lcodigotarjeta.Text
!total_subidas = lsubidas.Caption
!saldo = lsaldo.Caption
!fecha = lfecha.Caption
!contador = contador + 1
.Update
End With
registro.Close
End Sub
Private Sub proceso()
Dim contador As Integer
Dim saldo As Double
Dim tarjeta As Integer
Set registro = New ADODB.Recordset
registro.Open "select cod_tarjeta, total_subidas from tarjeta where cod_tarjeta="" & Trim(lcodigotarjeta.Text) & """, conexion, adOpenDynamic, adLockOptimistic
With registro
If Not registro.EOF Then
While Not registro.EOF
contador = !total_subidas - 1
tarjeta = Mid(lcodigotarjeta.Text, 7, 1)
If tarjeta = 0 Then "tarjeta especial
lsaldo.Caption = contador * viaje_e
Else
lsaldo.Caption = contador * viaje_n
End If
registro.MoveNext
Wend
" grabar todavia no
Else
lsaldo.Font.Size = 20
lsaldo.ForeColor = &HC0&
lsaldo.Caption = "NO IDENTIFICADA"
End If
End With
lsubidas.Caption = contador
registro.Close
End Sub
Pd: Por fa Jorgito escribeme a mi correo
ardnax@mixmail.comPara poder explicarte lo que realmente ahora me esta fallando con este cod.
