Título: leer datos en archivo secuencial
Publicado por: corlo en 22 Noviembre 2021, 16:41 pm
Hola soy corlo estoy haciendo una mini aplicacion de guardar datos de factura y leerlos por pantalla, en archivo secuencial. guardar datos lo hace bien el problema esta en leer los datos de la factura en pantalla el archivo es 1.txt y hay lo siguiente: ============================== COMPROBANTE DE VENTA ============================== TICKET Nº: 1 TIPO : CONTADO FECHA : 20/11/2021 HORA : 20:30:59 ------------------------------------------------------- R.U.C/C.I : a CLIENTE : a =============================== CANTIDAD PRODUCTO PRECIO SUBTOTAL =============================== 12 r 8 96 3 k 1.5 4,5 =============================== TOTAL : 100,50 ------------------------------------------- GRACIAS POR SU COMPRA! me sale todo mezclado el código que tengo hasta ahora es el siguiente: Option Explicit Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Const LB_SETTABSTOPS = &H192 Dim I As Integer Dim orden As Integer 'numero de ticket Dim fecha As Date 'para leer la fecha Dim hora As Date 'para leer la hora Dim contado As String 'para contado Dim credito As String 'para credito Dim cedu1 As String ' para el RUC/C.I Dim nom1 As String ' para el cliente 'abajo son datos del list1 Dim cantidad As Integer Dim producto As String * 12 Dim preciox As String * 8 Dim subtot As Double 'varible del total Dim tot As Double Private Sub Command4_Click() End End Sub Private Sub Command5_Click() 'Nuevo registro '//recuperar el dato. Open App.Path & "\Numero1.txt" For Input As #1 Do While Not EOF(1) Input #1, orden Loop Close #1 Txtnum = orden + 1 List1.Clear txtCedula1.Text = "" txtNombre1.Text = "" total.Text = "" txtCedula1.SetFocus End Sub Private Sub Command6_Click() 'Guardar Factura Dim cantidadtotal As Double Dim k As Integer orden = Txtnum.Text On Error GoTo salir Open App.Path & "\Numero1.txt" For Append As #1 Print #1, Txtnum Close #1 Dim bmx As String bmx = App.Path + "\" + Txtnum + ".txt" Open bmx For Append As #1 Txtnum = orden Print #1, Print #1, Print #1, Print #1, Tab(1); String(44, "=") Print #1, Tab((44 - Len("COMPROBANTE DE VENTA")) \ 2); "COMPROBANTE DE VENTA" Print #1, Tab(1); String(44, "=") If Option1.Value = True Then Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CONTADO")); "TIPO : CONTADO" Else Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CREDITO")); "TIPO : CREDITO" End If Print #1, Tab(1); "FECHA : " & Date; Tab(44 - Len("HORA : " & Time)); "HORA : " & Time Print #1, Tab(1); String(44, "-") Print #1, Tab(1); "R.U.C/C.I : " & txtCedula1.Text Print #1, Tab(1); "CLIENTE : " & txtNombre1.Text Print #1, Tab(1); String(44, "=") Print #1, Tab(1); "CANTIDAD"; Tab(11); "PRODUCTO"; Tab(24); "PRECIO"; Tab(37); "SUBTOTAL" Print #1, Tab(1); String(44, "=") For k = 0 To List1.ListCount - 1 Print #1, List1.List(k) Next k Print #1, Tab(1); String(44, "=") Print #1, Tab(15); "TOTAL : "; Tab(43 - Len(Format(total.Text, "#,##0.00"))); Format(total.Text, "#,##0.00") Print #1, Tab(16); "-----------------------------" Print #1, Print #1, Tab((44 - Len("GRACIAS POR SU COMPRA!")) \ 2); "GRACIAS POR SU COMPRA!" For I = 1 To 10 Print #1, Next I Close #1 Option1.Value = False Option2.Value = False txtCedula1.Text = "" txtNombre1.Text = "" List1.Clear cant.Text = "" prod.Text = "" precio.Text = "" subtotal.Text = "" total.Text = "" cant.SetFocus Exit Sub salir: Dim msgb msgb = MsgBox("Error Nº : [ " & Err.Number & " ]" & " " & Err.Description, vbOKCancel + vbInformation) End Sub Private Sub Command7_Click() 'Leer Factura Dim tabs(0 To 3) As Long tabs(0) = 20 tabs(1) = 60 tabs(2) = 95 tabs(3) = 138 ' Set the tabs. SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1) Dim str As String Dim thj As String Dim plo As Boolean Dim j As Integer Dim h As Integer On Error GoTo lo List1.Clear thj = App.Path + "\" + Txtnum.Text + ".txt" If Dir(thj) <> "" Then Open thj For Input As #1 Input #1, orden Txtnum.Text = orden Input #1, fecha Label4.Caption = fecha Input #1, hora Label5.Caption = hora Input #1, contado Input #1, credito Input #1, cedu1, nom1 txtCedula1.Text = cedu1 txtNombre1.Text = nom1 While Not EOF(1) Input #1, cantidad, producto, preciox, subtot cant.Text = cantidad prod.Text = producto precio.Text = preciox subtotal.Text = subtot List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot Wend j = 0 For h = 0 To List1.ListCount - 1 j = j + Val(Split(List1.List(h), vbTab)(3)) Next h total.Text = j Close #1 End If If contado= contado Then Option1.Value = True Else If credito = credito Then Option2.Value = True End If End If Exit Sub lo: If Not plo = True Then MsgBox "La Factura no existe, gracias", vbCritical End If End Sub Private Sub Command8_Click() 'Agregar Dim h As Integer Dim j As Double cantidad = cant.Text producto = prod.Text preciox = precio.Text subtot = subtotal.Text List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot j = 0 For h = 0 To List1.ListCount - 1 j = j + Split(List1.List(h), vbTab)(3) Next h total.Text = Format(j, "#,##0.00") cant.Text = "" prod.Text = "" precio.Text = "" subtotal.Text = "" cant.SetFocus End Sub Private Sub Form_Load() Dim tabs(0 To 3) As Long tabs(0) = 20 tabs(1) = 123 tabs(2) = 237 tabs(3) = 370 SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1) Option1.Value = False Option2.Value = False Open App.Path & "\Numero1.txt" For Append As #1 Close #1 Open App.Path & "\Numero1.txt" For Append As #1 Close #1 '//recuperar el dato. Open App.Path & "\Numero1.txt" For Input As #1 Do While Not EOF(1) Input #1, orden Loop Close #1 Txtnum = orden + 1 End Sub Private Sub List1_Click() Text1.Text = Mid(List1.Text, 1, InStr(1, List1.Text, " ") - 1) Text2.Text = Mid(List1.Text, InStr(1, List1.Text, " ") + 1) I = List1.ListIndex End Sub Private Sub Option1_Click() Option2.Value = False End Sub Private Sub Option2_Click() Option1.Value = False End Sub Private Sub precio_KeyUp(KeyCode As Integer, Shift As Integer) subtotal.Text = cant.Text * Val(precio.Text) End Sub Private Sub Timer1_Timer() Label4.Caption = Date Label5.Caption = Format(Time, "hh:mm:ss") End Sub
Gracias
Título: Re: leer datos en archivo secuencial
Publicado por: Serapis en 24 Noviembre 2021, 01:09 am
' Nuevo registro: Private Sub Command5_Click() ' recuperar el dato. Open App.Path & "\Numero1.txt" For Input As #1 Do While Not EOF(1) Input #1, orden Loop Close #1
Esto no tiene sentido... Si intento buscarle uno, diría que intentas llegar a la última entrada, pero... el código en el botón guardar, no lo confirma, porque el guardado de datos tiene formato, luego ahí en ese bucle, lo único que haces es recorrer a saltos de 2 bytes (los bytes de un integer de vb6) con cada lectura... hasta llegar al final del fichero, pero ni siquiera hay garantías de eso, si el fichero tiene bytes impares. Open thj For Input As #1 Input #1, orden Txtnum.Text = orden Input #1, fecha Label4.Caption = fecha Input #1, hora Label5.Caption = hora Input #1, contado Input #1, credito Input #1, cedu1, nom1 txtCedula1.Text = cedu1 txtNombre1.Text = nom1 While Not EOF(1) Input #1, cantidad, producto, preciox, subtot cant.Text = cantidad prod.Text = producto Precio.Text = preciox subtotal.Text = subtot List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot Wend Close #1
Aquí, aunque está mejor tampoco es óptimo.... Si el fichero contiene pongamos 1000 registros, parece que todos están obligados a rescribir contínuamente ciertos textbox... Además, operando con registros, lo adecuado es usar una estructura, para escribir y leer de una sola vez cada registro... private type RegCompra NumTicket as integer FechaCompra as date Contado as string * ??? Credito as string * ??? Producto As String * 12 PrecioX As String * 8 ' por qué un string?. _Sería adecuado un single Cantidad as integer SubTotal As Double ' no requiere un dobule, basta con un single, no vas a realizar cantidades astronómicas que escapen a un single. end type
- Por qué llamarlo 'orden' si es el ´numero del ticket?. - Por que guardar a fichero la fecha y luego la hora, cuando la fecha guarda todo?. - Qué es credito y qué contado?. el método de pago?. Si es así crea una enumeracion: Private Enum MetodosDePago PAGO_AL_CONTRADO = 0 PAGO_CON_TCREDITO = 1 End Enum
Si 'credito es por ejemplo el número de la tarjeta de crédito, entonces si puede ser un string, en ese caso reserva una cantidad fija de caracteres. En ficheros con VB6, al guardar strings, hay 3 opciones, la más cómoda es definir una cadena de tamaño fijo, la otra es escribir tu mismo a fichero al momento de escribir el string, un integer indicando la cantidad de caracteres de esa cadena (que más adelante se usará para saber cuanto leer), la 3 opción es abrir el fichero 'for input', en cuyo caso vb6 se encarga previo a cada parámetro (incluido arrays), anteponer el tipo de dato guardado, es decir una cabecera donde se incluye el tipo e info adicional (si se precisa), para saber cuantos bytes leer con cada campo, esto lo hace más complejo, no tienes control de ello y acaba resultando lento... No es preciso guardar a fchero los textos esos de 'gracias por su visita' ni otros textos, tan solo los datos... tu luego tendrías en todo caso una función llamada 'ImprimirFactura(registro)' que crea ese reporte textual formateando los datos de un registro, por ejemplo para imprimirlo con la impresora (para practica, basta imprimirlo en una ventana aparte). Mi consejo es abrirlo 'for binary', en este modo tú tienes el control de cada byte, no se añade nada extra que tu desconozcas, lo que te da un control pleno sobre el contenido del fichero... además es más rápido al no tener que verificar cada cosa que se lee o escribe. Y tratándose de registros es conveniente que todos tengan el mismo tamaño, por lo que conviene que cada string en el resgistro tenga un tamaño fijo. Cuando se usa variable string de tipo fijo, utiliza exactamente esos caracteres y ninguno más... Entonces manejar tu fichero podría ser así: Private Enum MetodosDePago PAGO_AL_CONTRADO = 0 PAGO_CON_TCREDITO = 1 End Enum Private Type RegCompra NumTicket As Integer ' 1 FechaCompra As Date ' 3 MetodoDePago As Byte ' 11 Alineacion as byte ' 12 nada solo hace que el registro sea una cantidad par, para ser más efectivo en lecturas Producto As String * 12 ' 13 PrecioUnidad As Single ' 25 Cantidad As Integer ' 29 SubTotal As Single ' 31 End Type ' total: 34 bytes por registro Private Canal As Integer ' Número de canal de comunicación con el fichero. Private NumRegistros As Long Private reg1 As RegCompra ' para leer registros Private reg2 As RegCompra ' para escribir registro, así diferenciados, será más difícil equivocarnos ' Leer Factura Private Sub Command7_Click() If LeerFacturacion("poner aqui tu ruta") = True Then ' Activar en la interfaz lo que proceda Else ' desactivar de la interfaz lo que proceda End If ' para activar o desactivar es preferible tener una función que reciba un buleano y en base a ello activa o desactiva cada cosa que proceda... ya que también se llamaría desde 'cerrar' End Sub Private Function LeerFacturacion(ByRef Ruta As String) As Boolean Dim k As Integer If (Abrir(Ruta) = True) Then Get #Canal, 1, NumRegistros For k = 1 To NumRegistros Get #Canal, , reg1 Call List1.AddItem(SerializarRegistro(reg1)) Next ' Ahora si se quiere puede leerse de nuevo el primer registro para transferirlo a los textbox... list1.listindex = 0 ' para ello delegamos en el código que pondremos al listbox... End If End Function Private Sub TrasferirRegToTextbox(ByRef R As RegCompra) With R txtNumTicket.Text = .NumTicket txtFechaComprar.Text = CStr(.fecha) optMetodoPago(.MetodoDePago).Value = True ' 2 controles option con indices 0 y 1 'cheMetodoPago.value = .MetodoDePago ' también vale un checkbox, que cambie su 'caption' según su valor, alternando entre 'Pago al contado' o 'Pago con Tarjeta de crédito'. txtProducto.Text = .Producto txtPrecioUnidad.Text = CStr(.PrecioUnidad) txtCantidad.Text = CStr(.Cantidad) txtSubtotal.Text = CStr(.SubTotal) End With End Sub Private Sub PosicionarRegistro(ByVal Numregistro As Long) If (Abierto = True) Then Seek (Canal), (1 + ((Numregistro-1) * LenB(reg1))) End If End Sub Private Function SerializarRegistro(ByRef Registro As RegCompra, ByVal Separador As String) As String With Registro SerializarRegistro = CStr(.NumTicket) & Separador & CStr(.FechaCompra) & _ Separador & GetMetodoPago(.MetodoDePago) & Separador & .Producto & _ Separador & CStr(.Cantidad) & Separador & CStr(.PrecioUnidad) & Separador & CStr(.SubTotal) End With End Function Private Function GetMetodoPago(ByVal Metodo As MetodosDePago) As String If (Metodo = PAGO_AL_CONTRADO) Then GetMetodoPago = "Contado" Else GetMetodoPago = "T. Credito" End If End Function Private Function ExisteFichero(ByRef Ruta As String) As Boolean Dim j As Integer, file As String j = InStrRev(Ruta, "\") If (j > 0) Then file = LCase$(Right$(Ruta, Len(Ruta) - j)) ExisteFichero = (LCase$(Dir(Ruta, vbNormal)) = file) End If End Function Private Function Abrir(ByRef Ruta As String) As Boolean If (Abierto = True) Then Call Cerrar If (ExisteFichero(Ruta) = True) Then Canal = FreeFile On Error GoTo FalloApertura Open Ruta For Binary As #Canal FalloApertura: If (Err.Number > 0) Then Call MsgBox("Error al intentar abrir el fichero en la ruta:" & vbCrLf & Ruta & vbCrLf & Err.Description, vbInformation, "Error de apertura:") Err.Clear Else Abrir = True End If On Error GoTo 0 ' hay que desactivar el controlador de errores, si no, cualquier error posterior cae en este interceptador (si es el último activo)... End If End Function Public Property Get Abierto() As Boolean Abierto = (Canal > 0) End Property Private Function Cerrar() Close #Canal canal = 0 NumRegistros = 0 ' desactivar de la interfaz lo que proceda... End Function Private Sub List1_Click() If (Abierto = True) Then Call PosicionarRegistro(List1.ListIndex + 1) Get #Canal, , reg1 Call TrasferirRegToTextbox(reg1, vbtab) End If End Sub
Nota que cuando la apertura Falla, deben desactivarse x botones para no incurrir en errores, como el de 'nuevo registro-añadir', etc... Con esto abrimos y leemos cada registro, se transfiere al listbox (que ahora tiene más columnas, una por cada campo de la estructura-registro), y el primero se transfiere a los textbox. Nota como el botón para leer el fichero separa la operatoria de leer el fichero (que delega en una función) del resto de lo que tiene que hacerse en la interfaz, que se opera ahí, aunque también puede delegarse a otra función, porque al cerrar el fichero igualmente deben desactivarse ciertos controles de la interfaz. Tu código tiene mucho para comentar... pero no me apetece ahora señalarte cada cosita... Se me hace tarde, mañana si te place te pongo lo que correspondería para añadir un nuevo registro y guardarlo a fichero... incluso para buscar un determinado registro. Mientras échale un ojo al código...
Título: Re: leer datos en archivo secuencial
Publicado por: corlo en 24 Noviembre 2021, 16:21 pm
Hola Serapis gracias por responder me ha ayudado bastante pero tengo dos dudas sobre el codigo que has puesto de lectura. en donde dices leerfacturacion en el commandbutton7_click() Private Sub Command7_Click() If LeerFacturacion("poner aqui tu ruta") = True Then ' Activar en la interfaz lo que proceda Else ' desactivar de la interfaz lo que proceda End If ' para activar o desactivar es preferible tener una función que reciba un buleano y en base a ello activa o desactiva cada cosa que proceda... ya que también se llamaría desde 'cerrar' End Sub en donde dices, activar en la interfaz lo que proceda supongo que es [code=vb] abierto=true
en donde dices , desactivar de la interfaz lo que proceda abierto=false
y lo segundo cuando haces el private sub posicionarregistro la variable lenb(reg1) que significa Private Sub PosicionarRegistro(ByVal Numregistro As Long) If (Abierto = True) Then Seek (Canal), (1 + ((Numregistro-1) * LenB(reg1))) End If End Sub
gracias seria bueno me pudiese hacer el codigo de añadir un nuevo registro y guardarlo a fichero... incluso para buscar un determinado registro, para entender mejor el codigo, gracias [/code]
Título: Re: leer datos en archivo secuencial
Publicado por: Serapis en 24 Noviembre 2021, 23:55 pm
La instrucción LenB(variable), devuelve la cantidad de bytes que contiene esa variable, así como Len(string) devuelve la cantidad de caracteres (no necesariamente se corresponde con la cantidad de bytes). en cualquier caso, cuando tengas dudas, posicionar el cursor encima de la instrucción (o cualquier parte de la sintaxis de vb6), pulsa la tecla F1 y te lleva a la ayuda, donde tes explica su cometido y puede incluso contener algún ejemplo. Por cierto... esa función tiene un pequeño error del que me acabo de dar cuenta, te comento por encima: Lo habitual es que al comienzo de ficheros con un determinado formato, exista una cabecera (de tamaño fijo generlamente o al menos conocido antes de escribir lo que venga detrás), en este caso la cabecera está compuesta por un único dato: 'NumRegistros', que al ocupar 4 bytes (del long de vb6), debe añadirse para calcular la posición absoluta de lectura/escritura de comienzo de u registor dado, es decir el primer registor debe comenzar en la posición 5 (vb6 considera que un fichero comienza siempre en la posición 1). Private Sub PosicionarRegistro(ByVal Numregistro As Long) If (Abierto = True) Then Seek (Canal), (5 + ((Numregistro-1) * LenB(reg1))) End If End Sub
-------------------------------------------------------------------------- Tu segunda duda: para activar o desactivar ... lo que proceda Lo razonable es que hayas elementos en la interfaz que estén 'sincronizados' con determinados estados... por ejemplo el botón 'guardar' registro debería estar desactivado mientras no se haya abierto el fichero. Si ni siquiera existe un fichero, es adecuado que esté habilitado un botón 'Crear nueva Factuación' (imagina por ejemplo un fichero por cada mes), que cierre el previo, vacíe el listado y los textbox, crea y abre un nuevo fichero y entonces activa los botones de añadir registro y buscar y cerrar, etc... Siempre se puede añadir una comprobación dle tipo: si Abierto=true luego ... fin si En el código (por ejemplo) del botón guardar registro, peor lo ideal es que si no se puede guardar, ese btón no estuviere activo. --------------------------------------- ...me edito, para ponerte el código... estará sin terminar al completo y sin provar ya que va siendo tarde, mira a ver si completas lo que falta (el código de los botones) y alguna pequeña función... Nota que te pongo todo de nuevo, porque he cambiado alguna cosa... la función abrir, ahora debe abrir bajo dos condiciones, cuando se lee un fichero existente y cuando se pretende crear un nuevo fichero (que no debe existir)... Las funciones añadidas, están al final... falta el código de los botones y alguna función más para completarlo. Abajo pongo una capturas de como se vería la interfaz y vale por hoy. Private Enum MetodosDePago PAGO_AL_CONTRADO = 0 PAGO_CON_TCREDITO = 1 End Enum Private Type RegCompra NumTicket As Integer ' 1 FechaCompra As Date ' 3 MetodoDePago As Byte ' 11 Alineacion As Byte ' 12 nada solo hace que el registro sea una cantidad par, para ser más efectivo en lecturas Producto As String * 12 ' 13 PrecioUnidad As Single ' 25 Cantidad As Integer ' 29 SubTotal As Single ' 31 End Type ' total: 34 bytes por registro Private Const DIR_COMIENZO_REGS As Long = 9 ' 1+4+4 Private NumRegistros As Long Private AutonIncRegs As Long ' Private Canal As Integer ' Número de canal de comunicación con el fichero. Private reg1 As RegCompra ' para leer registros Private reg2 As RegCompra ' para escribir registro, así diferenciados, será más difícil equivocarnos Private Sub ComNuevaFacturacion_Click() If (Len(TxtFile.Text) > 0) Then Call CrearNuevaFacturacion(TxtFile.Text) End If End Sub Private Sub ComAbrirFacturacion_Click() Form2.Show 1 If (Len(Form2.File) > 0) Then If (LeerFacturacion(App.Path & "\" & Form2.File) = True) Then Call Activar(True) Else Call Activar(False) End If End If End Sub Private Sub ComBuscar_Click() ' End Sub Private Sub ComEditarRegistro_Click() ' End Sub Private Sub ComGuardarRegistro_Click() ' End Sub Private Sub ComRetirarRegistro_Click() ' End Sub Private Sub ComSalir_Click() ' End Sub Private Sub List1_Click() If (Abierto = True) Then Call PosicionarRegistro(List1.ListIndex + 1) Get #Canal, , reg1 Call TrasferirRegToTextbox(reg1, vbTab) End If End Sub ' ------------ Fin interfaz ------------------ Private Function LeerFacturacion(ByRef Ruta As String) As Boolean Dim k As Integer If (Abrir(Ruta) = True) Then Get #Canal, 1, NumRegistros For k = 1 To NumRegistros Get #Canal, , reg1 Call List1.AddItem(SerializarRegistro(reg1)) Next ' Ahora si se quiere puede leerse de nuevo el primer registro para transferirlo a los textbox... List1.ListIndex = 0 ' para ello delegamos en el código que pondremos al listbox... End If End Function Private Sub TrasferirRegToTextbox(ByRef R As RegCompra) With R txtNumTicket.Text = .NumTicket txtFechaComprar.Text = CStr(.fecha) optMetodoPago(.MetodoDePago).Value = True ' 2 controles option con indices 0 y 1 'cheMetodoPago.value = .MetodoDePago ' también vale un checkbox, que cambie su 'caption' según su valor, alternando entre 'Pago al contado' o 'Pago con Tarjeta de crédito'. txtProducto.Text = .Producto txtPrecioUnidad.Text = CStr(.PrecioUnidad) txtCantidad.Text = CStr(.Cantidad) txtSubtotal.Text = CStr(.SubTotal) End With End Sub Private Sub PosicionarRegistro(ByVal Numregistro As Long) If (Abierto = True) Then Seek (Canal), (DIR_COMIENZO_REGS + ((Numregistro - 1) * LenB(reg1))) End If End Sub Private Function SerializarRegistro(ByRef Registro As RegCompra, ByVal Separador As String) As String With Registro SerializarRegistro = CStr(.NumTicket) & Separador & CStr(.FechaCompra) & _ Separador & GetMetodoPago(.MetodoDePago) & Separador & .Producto & _ Separador & CStr(.Cantidad) & Separador & CStr(.PrecioUnidad) & Separador & CStr(.SubTotal) End With End Function Private Function GetMetodoPago(ByVal Metodo As MetodosDePago) As String If (Metodo = PAGO_AL_CONTRADO) Then GetMetodoPago = "Contado" Else GetMetodoPago = "T. Credito" End If End Function Private Function ExisteFichero(ByRef Ruta As String) As Boolean Dim j As Integer, File As String j = InStrRev(Ruta, "\") If (j > 0) Then File = LCase$(Right$(Ruta, Len(Ruta) - j)) ExisteFichero = (LCase$(Dir(Ruta, vbNormal)) = File) End If End Function ' Abre un fichero que YA EXISTE: Cuando se solicita leer la facturación de uno. ' Abre un fichero que NO EXISTE: Cuando se trata de crear una nueva facturación. Private Function Abrir(ByRef Ruta As String, Optional ByVal NoDebeExistir As Boolean = False) As Boolean If (Abierto = True) Then Call Cerrar If (ExisteFichero(Ruta) = False) Then If (NoDebeExistir = False) Then Exit Function End If Canal = FreeFile On Error GoTo FalloApertura Open Ruta For Binary As #Canal FalloApertura: If (Err.Number > 0) Then Call MsgBox("Error al intentar abrir el fichero en la ruta:" & vbCrLf & Ruta & vbCrLf & Err.Description, vbInformation, "Error de apertura:") Err.Clear Else Abrir = True End If On Error GoTo 0 ' hay que desactivar el controlador de errores, si no, cualquier error posterior cae en este interceptador (si es el último activo)... End Function Public Property Get Abierto() As Boolean Abierto = (Canal > 0) End Property Private Function Cerrar() Close #Canal Canal = 0 NumRegistros = 0 ' desactivar de la interfaz lo que proceda... End Function ' ------------------------------------------------- ' -------- NUEVO DESDe AQUI --------------- '-------------------------------------------------- ' Index refiere al enésimo registor en el fichero. ' Si es -1 refiere al último, lo adecuaod cuando se añade. ' Si es entre 1 y NumRegistros, señala que es un registro que se ha editado... Private Sub GuardarRegistro(ByRef R As RegCompra, Optional ByVal Index As Long = -1) If (R.NumTicket = 0) Then AutonIncRegs = (AutonIncRegs + 1) R.NumTicket = AutonIncRegs End If ' If (Index = -1) Then NumRegistros = (NumRegistros + 1) Index = NumRegistros End If Call PosicionarRegistro(Index) Put #Canal, , R ' Guarda el registro Put #Canal, 1, NumRegistros ' Guarda la cantidad de registros Put #Canal, , AutonIncRegs ' Guarda el valor de autoincrmeento (es un valor único). End Sub Private Function CrearNuevaFacturacion(ByRef NombreFile As String) As Boolean Dim Ruta As String Ruta = App.Path & "\" & NombreFile If (Abrir(Ruta, True) = True) Then NumRegistros = 0: AutonIncRegs = 0 Put #Canal, 1, NumRegistros ' Guarda la cantidad de registros Put #Canal, , AutonIncRegs ' Guarda el valor de autoincrmeento (es un valor único). CrearNuevaFacturacion = True Else MsgBox "Parece que el fichero que intenta abrir ya existe, elija otro nombre (o bien ocurrió un error)..." End If End Function ' Numreg: Permite seguir buscando más artículos a partir del previo que se encontró... Private Function BuscarArticulo(ByRef Producto As String, Optional ByRef NumReg As Long = 0) As Boolean Dim k As Long, ptr As Long, inc As Long, Articulo As String * 12 If (NumReg < NumRegistros) Then NumReg = (NumReg + 1) If (NumReg > 1) Then Call PosicionarRegistro(NumReg) ptr = Seek(Canal) + 12 Else ptr = (DIR_COMIENZO_REGS + 12) ' Dir de comienzo de registros + desplazamiento al campo soliicitado. End If Producto = LCase(Producto) inc = LenB(reg1) For k = NumReg To NumRegistros Get #Canal, ptr, Articulo If (LCase$(Articulo) = Producto) Then Get #Canal, ptr - 12, reg1 BuscarArticulo = True Exit For End If ptr = (ptr + inc) Next NumReg = k End If End Function ' En cada fichero cada compra tiene un numero de ticket único (no hay dos repetidos, como si puede pasar con el nombre del artículo). Private Function BuscarTicket(ByVal Ticket As Long) As Boolean Dim k As Long, ptr As Long, inc As Long, nTicket As Long ptr = DIR_COMIENZO_REGS ' Dir de comienzo de registros + desplazamiento al campo soliicitado=0. inc = LenB(reg1) For k = 1 To NumRegistros Get #Canal, ptr, nTicket If (LCase$(nTicket) = Ticket) Then Get #Canal, ptr, reg1 BuscarTicket= True Exit For End If ptr = (ptr + inc) Next End Function
Yo elegiría un control flexgrid en vez de un listbox, que ya tiene sus columnas y tal, pero es más complejo de manejar para empezar... Nota que la interfaz de momento la dejo así, solo para que puedas captar todos los detalles que contiene. En realidad cosas como los textbox deben ir a una ventana aparte donde se editen o creen... pero así no te hago esperar si ves todo lo que contiene e intentas por tí mismo completarlo. (http://imgfz.com/i/vporBsE.png)
Título: Re: leer datos en archivo secuencial
Publicado por: corlo en 25 Noviembre 2021, 19:20 pm
Hola Serapis gracias por el codigo
tengo unas dudas sobre el codigo
combuscar para buscar funcion buscararticulo como seria
comeditarregistro no encuentro la funcion
comretirarregistro no encuentro la funcion
tengo un error en el optionbuton1 optionbuton2 me da un error en la funcion: El miembro ya existe en un módulo de objeto con los controladores de este módulo de objeto
en los dos optionbuton le pongo en el nombre getmetodopago y me pone el error
gracias
Título: Re: leer datos en archivo secuencial
Publicado por: Serapis en 25 Noviembre 2021, 20:05 pm
Esperaba que pudieras deducir que se trata de botones...
No es necesario poner código para los optionbuttons, además deben formar un array, esto es deben tener el mismo nombre pero uno con índice 0 y otro 1, así su índice ya refiere su valor sobre el método de pago.
La función 'getmetodopago', si te fijas bien en lo que hace, simplemente devuelve un string, en base al valor recibido... eso solo se usa para convertir el valor del método de pago en el string, que luego se va a introducir al listbox (pasar al listbox, 0 ó 1, no dice nada útil ni comprensible).
Creo que estás más verde aún de lo que parece en cuanto al dominio no solo del lenguaje sino de claridad de ideas respecto de la programación.
Normalmente 'el conocimiento' y 'la inteligencia' (las capacidades intelecturales) es algo innato, que al programar uno debe saber 'traducir' y respecto del lenguaje es algo que sí o sí uno debe aprender desde cero (esto pasa con cualquier nuevo lenguaje que uno quiera aprender). Quiero decir que la programación no es un invento, sino el resultado del intelecto, aplícalo y la programación será más fácil, si partes de la idea de que la programación es un invento de alguien, entonces te será difícil aplicarte, porque parece exigir aprender o ponerte en el pellejo de quien 'lo inventó'. Eso es cierto para el lenguaje, que suele obedecer en ocasiones al capricho de su diseñador aunque en buena medida es el resultado de meditar y madurar ideas... Si intentas aplicar lógica con inteligencia a la programación, el resto sólo depende de la profundidad en que conozcas el lenguaje en el que pretendes escribirlo.
Bien, respecto del asunto, en realidad anoche lo dejé más avanzado, de lo que te envié, en un momento, simplemente me pareció que era preferible copiarlo y guardarlo para enviártelo así y desde ahí intentaras por tu cuenta a modo de ejercicio completar lo que faltara, para ver como lo resolvías. Los botones de la interfaz, por ejemplo los moví a un menú, los textbox a una ventana para editar el registro, los valores de búsqueda a otra ventana para lo mismo, definir los parámetros de búsqueda, cambié alguna cosa más... y deje para hoy solamente la activación y desactivación de los botones (ahora en el menú), según correspondan... lo terminaré más tarde, después de cenar. Te comentaré por aquí por encima, y subiré copia a alguna página de descarga...
Título: Re: leer datos en archivo secuencial
Publicado por: corlo en 26 Noviembre 2021, 22:00 pm
gracias serapis
primero no lo he podido terminar por que faltaban cosas
agregar a list1
lo de editar
lo retirar registro
tu trabajas con funciones , me has cambiado la manera de trabajar, tengo que seguir con lo que dices tu, yo ya no puedo trabajar con lo que hacia yo.
Gracias
Título: Re: leer datos en archivo secuencial
Publicado por: Serapis en 26 Noviembre 2021, 23:27 pm
tu trabajas con funciones , me has cambiado la manera de trabajar, tengo que seguir con lo que dices tu, yo ya no puedo trabajar con lo que hacia yo.
Ok... Ayer al final no me puse con él. ...pero lo acabo de terminar ahora y probar por encima... he cambiado algunos detalles (por ejemplo el orden en que muestran los campos en el listbox) y corregido algunas diferencias (por ejemplo, en el registro el numero de ticket estaba definido como entero, y la busqueda suponía en long, lógicamente no lo encontraría de esa manera). Te comparto del proyecto completo... incluye un fichero de ejemplo con algunos registros guardados. Lo modificas a tu necesidad, pero recuerda que si cambias la estructura del registro (type...), elimina el fichero y crea uno nuevo. Por ejemplo el campo 'producto' es demasiado brece (12 caracteres), si pongo 'Destronilladores' no cabe ni mucho menos 'juego de ...' 30-40 caracteres, estaría bien. Nota que la búsqueda por artículo exige que sea exacta (salvando la capitalización), sería adecuado modificarlo o añadir un parámetro para localizar por similitud (like, o contiene parcialmente...). Enlace de descarga: https://workupload.com/file/AHRpXupVQQz 11Kb. aprox. descomprimido 35.5kb, aprox. No hay mucho que explicar, revisa el código ejecutándolo paso a paso, para entender cada cosa, céntrate cada vez en una sola cosa... manejo de ficheros, lectura/escritura de datos, edición de un registro, validaciones, etc... (http://imgfz.com/i/PE7gatA.png) Si necesitas alguna aclaración, pregunta.
Título: Re: leer datos en archivo secuencial
Publicado por: corlo en 27 Noviembre 2021, 00:20 am
Hola Serapis
gracias por poner el archivo de descarga, pero no lo puedo descargar
me sale Secure Net ha bloqueado el contenido
El contenido de f65.workupload.com se ha considerado inseguro. Secure Net te recomienda cerrar esta página y seguir navegando.
me lo puedes poner en mediafire o por mega , gracias
Título: Re: leer datos en archivo secuencial
Publicado por: Serapis en 27 Noviembre 2021, 02:02 am
Pues vaya M13RD@ de 'antivirus'... solo contiene los ficheros del proyecto más el fichero de ejemplo que desde luego no es un ejecutable. Subirlo a otro lado, no creo que solvente el asunto... el fichero zip es el mismo, quien lo detiene es ese tonto-antivirus (no la web), que desde luego parece inútil. Mira de desactivar el antivirus ese (eso es de vodafone, no?) , descárgalo y luego si quieres puedes pasarlo por virustotal, pero vamos con abrir el zip, se ve que no contiene nada 'malicioso'. No olvides volver a activar ese antivirus si lo encuentras útil... En esta pagina te viene cono activarlo y desactivarlo: https://www.adslzone.net/operadores/vodafone/vodafone-secure-net/ ¿Por lo que leo (un vistazo rápido) es para móviles, porqué no lo descargas desde el PC?. p.d.: Me edito... Si en cualquier momento queremos desactivar el servicio, desde cualquier dispositivo 1 abrimos una ventana de nuestro navegador favorito, 2 pulsamos sobre el icono de Vodafone Secure Net, seleccionamos el botón de ajustes 3 y en la parte inferior de la página 4 pulsamos sobre la opción Desactivar.
Título: Re: leer datos en archivo secuencial
Publicado por: corlo en 27 Noviembre 2021, 10:14 am
gracias serapis
lo he podido descargar
lo he mirado por encima y funciona bien ya mirare los detalles con mas calma
muchas gracias
Título: Re: leer datos en archivo secuencial
Publicado por: corlo en 30 Diciembre 2021, 18:48 pm
Hola serapis
fataria buscar por articulo, he mirado varias cosas y no hay manera
del primer programa
gracias
Título: Re: leer datos en archivo secuencial
Publicado por: Serapis en 31 Diciembre 2021, 17:36 pm
Si con 'el primer programa', te refieres a la primera versión en zip que subí, sucede lo mismo que te comentaba en el último... El registro tiene para el campo artículo un valor de tipo string de tamaño 'fijo' (...as string *12), es decir se rellena con espacios al final si el artículo no completa el tamaño del campo. Hay esto en el código: ... Get #Canal, ptr, Articulo If (LCase$(Articulo) = Producto) Then ...
Falta por tanto eliminar los espacios, tan simple como cambiarlo por esto: ... Get #Canal, ptr, Articulo If (LCase$(trim$(Articulo)) = Producto) Then ...
En cualquier caso, debes utilizar las herramientas de debug, que el IDE ofrece (El IDE no sirve meramente para dejar colorido el texto, tiene muchas herramientas interesantes)... Si revisas el contenido del valor 'Producto' justo donde se hace la comparación, verás que es: "alicates" ...y de igual modo con la expresión 'LCase$(Articulo)', verías que es: "alicates " ...se observa que en efecto se diferencian en los espacios, luego la solución aparece obvia, sin entrar en pánico ni revisiones complejas. Puedes poner un simple punto de parada en dicha línea (pulsa la tecla F9 encima de dicha línea en tu código y ejecuta el programa (estamos en modo diseño, ahí se interpreta)... al llegar a esa línea con un punt de parada, el intérprete se para en dicha línea, teniendo ahí el cursor, puedes hacer desde un simple: debug.print "." & articulo & "." , "." & lcase$(articulo) & "." ' los puntos son solo para determinar claramente donde empiea y termina el string, lo espacios pueden pasar desapercibido...
Sea pegando está línea justo antes de esa y ejecutándola, o abriendo la ventana de pruebas (inmediato) CTRL+G (o buscarla desde el menú --> Ver ...). También simplemente seleccionado una expresión y desde el: 'menú --> debug --> inspeccion rapida', etc... mejor si se edita el propio menú para tenerlo en el menú contextual. Por último se te señalo que la comparación, además de no ignorar espacios, exige exactitud, de ahí que incluso sea preferible hacer una búsqueda parcial... ...también sucede que la búsqueda se realiza desde el comienzo, luego, si encuentra el primer registro que cumple la condición y sale... una nueva búsqueda (sin más), para lo mismo volverá a buscar desde el inicio y volverá a encontrar exactamente el mismo registro (si no se eliminó y lo que se busca es lo mismo que antes)... pero... en el último programa (que subí)... la capacidad para seguir buscando desde el previo encontrado, está implementadaasí como una búsqueda parcial, (podrás ver en el menú que aparece un 'buscar siguiente', que admeás se activa o desactiva conforme la posibilidad de buscar un siguiente exista)... La búsqueda parcial de un artículo tira del operador 'like' (que es la forma de usar expresiones regulares en vb6), por lo que te conviene que si pasas al primer proyecto, al menos incluyas los cambios acometidos a este respecto en el segundo (en el primero solo se dejó 'insinuado' dicha posibilidad, completarlo quedaba a tu cargo, sin embargo en el segundo lo dejé hecho).
Título: Re: leer datos en archivo secuencial
Publicado por: corlo en 31 Diciembre 2021, 18:37 pm
muchas gracias serapis en el ejemplo que tu ponias a la hora de introducir los datos no salia bien pero al hacer una entrada de facturacion nueva aqui introduzco los datos y ahora si que sale ... Get #Canal, ptr, Articulo If (LCase$(trim$(Articulo)) = Producto) Then ...
habia probado de varias maneras y no habia manera de que saliese muchas gracias que tengas un buen año 2022 Gracias
|