elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Tutorial básico de Quickjs


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  leer datos en archivo secuencial
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] 2 Ir Abajo Respuesta Imprimir
Autor Tema: leer datos en archivo secuencial  (Leído 608 veces)
corlo

Desconectado Desconectado

Mensajes: 53


Ver Perfil
leer datos en archivo secuencial
« 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:


Código
  1.  
  2. Option Explicit
  3. 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
  4. Private Const LB_SETTABSTOPS = &H192
  5. Dim I As Integer
  6. Dim orden As Integer 'numero de ticket
  7. Dim fecha As Date 'para leer la fecha
  8. Dim hora As Date 'para leer la hora
  9. Dim contado As String 'para contado
  10. Dim credito As String 'para  credito
  11. Dim cedu1 As String ' para el RUC/C.I
  12. Dim nom1 As String ' para el cliente
  13. 'abajo son datos del list1
  14. Dim cantidad As Integer
  15. Dim producto As String * 12
  16. Dim preciox As String * 8
  17. Dim subtot As Double
  18. 'varible del total
  19. Dim tot As Double
  20. Private Sub Command4_Click()
  21. End
  22. End Sub
  23.  
  24. Private Sub Command5_Click()
  25. 'Nuevo registro
  26. '//recuperar el dato.
  27. Open App.Path & "\Numero1.txt" For Input As #1
  28. Do While Not EOF(1)
  29. Input #1, orden
  30. Loop
  31. Close #1
  32. Txtnum = orden + 1
  33.  
  34.  
  35.  
  36.      List1.Clear
  37.     txtCedula1.Text = ""
  38.     txtNombre1.Text = ""
  39.     total.Text = ""
  40.     txtCedula1.SetFocus
  41.  
  42.  
  43. End Sub
  44.  
  45.  
  46.  
  47. Private Sub Command6_Click()
  48. 'Guardar Factura
  49.  
  50. Dim cantidadtotal As Double
  51. Dim k As Integer
  52.  
  53.  
  54. orden = Txtnum.Text
  55. On Error GoTo salir
  56.  
  57.  
  58.  
  59.  
  60.  
  61.    Open App.Path & "\Numero1.txt" For Append As #1
  62.  
  63.    Print #1, Txtnum
  64.    Close #1
  65.  
  66. Dim bmx As String
  67. bmx = App.Path + "\" + Txtnum + ".txt"
  68.  
  69.  Open bmx For Append As #1
  70.  
  71.  
  72.  Txtnum = orden
  73.  
  74.  
  75.  
  76.    Print #1,
  77.  
  78.    Print #1,
  79.  
  80.    Print #1,
  81.  
  82.  
  83.    Print #1, Tab(1); String(44, "=")
  84.    Print #1, Tab((44 - Len("COMPROBANTE DE VENTA")) \ 2); "COMPROBANTE DE VENTA"
  85.    Print #1, Tab(1); String(44, "=")
  86.  
  87.    If Option1.Value = True Then
  88.        Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CONTADO")); "TIPO : CONTADO"
  89.    Else
  90.        Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CREDITO")); "TIPO : CREDITO"
  91.    End If
  92.  
  93.    Print #1, Tab(1); "FECHA : " & Date; Tab(44 - Len("HORA : " & Time)); "HORA : " & Time
  94.  
  95.    Print #1, Tab(1); String(44, "-")
  96.  
  97.    Print #1, Tab(1); "R.U.C/C.I : " & txtCedula1.Text
  98.    Print #1, Tab(1); "CLIENTE   : " & txtNombre1.Text
  99.  
  100.    Print #1, Tab(1); String(44, "=")
  101.    Print #1, Tab(1); "CANTIDAD"; Tab(11); "PRODUCTO"; Tab(24); "PRECIO"; Tab(37); "SUBTOTAL"
  102.    Print #1, Tab(1); String(44, "=")
  103.  
  104.  
  105. For k = 0 To List1.ListCount - 1
  106. Print #1, List1.List(k)
  107. Next k
  108.  
  109.  
  110.  
  111.    Print #1, Tab(1); String(44, "=")
  112.    Print #1, Tab(15); "TOTAL : "; Tab(43 - Len(Format(total.Text, "#,##0.00"))); Format(total.Text, "#,##0.00")
  113.    Print #1, Tab(16); "-----------------------------"
  114.  
  115.  
  116.  
  117.    Print #1,
  118.    Print #1, Tab((44 - Len("GRACIAS POR SU COMPRA!")) \ 2); "GRACIAS POR SU COMPRA!"
  119.  
  120.    For I = 1 To 10
  121.        Print #1,
  122.    Next I
  123.  
  124.    Close #1
  125.  
  126.  
  127.  Option1.Value = False
  128. Option2.Value = False
  129.  
  130. txtCedula1.Text = ""
  131. txtNombre1.Text = ""
  132.    List1.Clear
  133. cant.Text = ""
  134. prod.Text = ""
  135. precio.Text = ""
  136. subtotal.Text = ""
  137. total.Text = ""
  138. cant.SetFocus
  139.  
  140.    Exit Sub
  141.  
  142. salir:
  143.  
  144. Dim msgb
  145.  
  146. msgb = MsgBox("Error Nº : [ " & Err.Number & " ]" & " " & Err.Description, vbOKCancel + vbInformation)
  147.  
  148.  
  149. End Sub
  150.  
  151.  
  152.  
  153. Private Sub Command7_Click()
  154. 'Leer Factura
  155. Dim tabs(0 To 3) As Long
  156.    tabs(0) = 20
  157.    tabs(1) = 60
  158.    tabs(2) = 95
  159.    tabs(3) = 138
  160.    ' Set the tabs.
  161.    SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1)
  162.  
  163.  
  164.  
  165. Dim str As String
  166. Dim thj As String
  167. Dim plo As Boolean
  168. Dim j As Integer
  169. Dim h As Integer
  170. On Error GoTo lo
  171. List1.Clear
  172. thj = App.Path + "\" + Txtnum.Text + ".txt"
  173. If Dir(thj) <> "" Then
  174. Open thj For Input As #1
  175.  
  176. Input #1, orden
  177. Txtnum.Text = orden
  178. Input #1, fecha
  179. Label4.Caption = fecha
  180. Input #1, hora
  181. Label5.Caption = hora
  182. Input #1, contado
  183. Input #1, credito
  184.  
  185. Input #1, cedu1, nom1
  186.  
  187. txtCedula1.Text = cedu1
  188. txtNombre1.Text = nom1
  189.  
  190. While Not EOF(1)
  191.  
  192. Input #1, cantidad, producto, preciox, subtot
  193. cant.Text = cantidad
  194. prod.Text = producto
  195. precio.Text = preciox
  196. subtotal.Text = subtot
  197. List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot
  198. Wend
  199.  
  200. j = 0
  201.   For h = 0 To List1.ListCount - 1
  202. j = j + Val(Split(List1.List(h), vbTab)(3))
  203. Next h
  204. total.Text = j
  205.  
  206.  
  207.  
  208. Close #1
  209. End If
  210.  
  211. If contado= contado Then
  212. Option1.Value = True
  213. Else
  214.  
  215. If credito = credito Then
  216. Option2.Value = True
  217.  
  218. End If
  219. End If
  220.  
  221.  
  222.  
  223.  
  224.  
  225. Exit Sub
  226. lo:
  227. If Not plo = True Then
  228. MsgBox "La Factura no existe, gracias", vbCritical
  229. End If
  230. End Sub
  231.  
  232. Private Sub Command8_Click()
  233. 'Agregar
  234. Dim h As Integer
  235. Dim j As Double
  236.  
  237. cantidad = cant.Text
  238. producto = prod.Text
  239. preciox = precio.Text
  240. subtot = subtotal.Text
  241.  
  242. List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot
  243. j = 0
  244.   For h = 0 To List1.ListCount - 1
  245. j = j + Split(List1.List(h), vbTab)(3)
  246. Next h
  247. total.Text = Format(j, "#,##0.00")
  248. cant.Text = ""
  249. prod.Text = ""
  250. precio.Text = ""
  251. subtotal.Text = ""
  252. cant.SetFocus
  253. End Sub
  254.  
  255. Private Sub Form_Load()
  256. Dim tabs(0 To 3) As Long
  257.  
  258.    tabs(0) = 20
  259.    tabs(1) = 123
  260.    tabs(2) = 237
  261.    tabs(3) = 370
  262.  
  263.    SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1)
  264.  
  265. Option1.Value = False
  266. Option2.Value = False
  267.  
  268. Open App.Path & "\Numero1.txt" For Append As #1
  269. Close #1
  270. Open App.Path & "\Numero1.txt" For Append As #1
  271. Close #1
  272.  
  273. '//recuperar el dato.
  274. Open App.Path & "\Numero1.txt" For Input As #1
  275. Do While Not EOF(1)
  276. Input #1, orden
  277. Loop
  278. Close #1
  279. Txtnum = orden + 1
  280.  
  281. End Sub
  282.  
  283. Private Sub List1_Click()
  284. Text1.Text = Mid(List1.Text, 1, InStr(1, List1.Text, " ") - 1)
  285. Text2.Text = Mid(List1.Text, InStr(1, List1.Text, " ") + 1)
  286. I = List1.ListIndex
  287. End Sub
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294. Private Sub Option1_Click()
  295. Option2.Value = False
  296. End Sub
  297.  
  298. Private Sub Option2_Click()
  299. Option1.Value = False
  300. End Sub
  301.  
  302. Private Sub precio_KeyUp(KeyCode As Integer, Shift As Integer)
  303. subtotal.Text = cant.Text * Val(precio.Text)
  304. End Sub
  305.  
  306. Private Sub Timer1_Timer()
  307. Label4.Caption = Date
  308. Label5.Caption = Format(Time, "hh:mm:ss")
  309. End Sub
  310.  
  311.  
  312.  




Gracias




En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 2.865


Ver Perfil
Re: leer datos en archivo secuencial
« Respuesta #1 en: 24 Noviembre 2021, 01:09 am »

Citar
Código
  1. ' Nuevo registro:
  2. Private Sub Command5_Click()     ' recuperar el dato.
  3.    Open App.Path & "\Numero1.txt" For Input As #1
  4.    Do While Not EOF(1)
  5.        Input #1, orden
  6.    Loop
  7.    Close #1
  8.  
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.

Citar
Código
  1. Open thj For Input As #1
  2.            Input #1, orden
  3.            Txtnum.Text = orden
  4.            Input #1, fecha
  5.            Label4.Caption = fecha
  6.            Input #1, hora
  7.            Label5.Caption = hora
  8.            Input #1, contado
  9.            Input #1, credito
  10.  
  11.            Input #1, cedu1, nom1
  12.  
  13.            txtCedula1.Text = cedu1
  14.            txtNombre1.Text = nom1
  15.  
  16.            While Not EOF(1)
  17.                Input #1, cantidad, producto, preciox, subtot
  18.                cant.Text = cantidad
  19.                prod.Text = producto
  20.                Precio.Text = preciox
  21.                subtotal.Text = subtot
  22.                List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot
  23.            Wend
  24.        Close #1
  25.  
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...
Código
  1. private type RegCompra
  2.    NumTicket          as integer        
  3.    FechaCompra     as date
  4.    Contado             as string * ???  
  5.    Credito              as string * ???
  6.  
  7.    Producto             As String * 12
  8.    PrecioX               As String * 8    ' por qué un string?. _Sería adecuado un single
  9.    Cantidad             as integer
  10.    SubTotal             As Double        ' no requiere un dobule, basta con un single, no vas a realizar cantidades astronómicas que escapen a un single.
  11. end type
  12.  
- 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:
Código
  1. Private Enum MetodosDePago
  2.   PAGO_AL_CONTRADO = 0
  3.   PAGO_CON_TCREDITO = 1
  4. End Enum
  5.  

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í:
Código
  1. Private Enum MetodosDePago
  2.   PAGO_AL_CONTRADO = 0
  3.   PAGO_CON_TCREDITO = 1
  4. End Enum
  5.  
  6. Private Type RegCompra
  7.    NumTicket           As Integer     ' 1
  8.    FechaCompra         As Date      ' 3
  9.    MetodoDePago        As Byte      ' 11
  10.    Alineacion            as byte         ' 12 nada solo hace que el registro sea una cantidad par, para ser más efectivo en lecturas  
  11.  
  12.    Producto            As String * 12  ' 13
  13.    PrecioUnidad        As Single       ' 25
  14.    Cantidad            As Integer       ' 29
  15.    SubTotal            As Single        ' 31
  16.  
  17. End Type                                ' total: 34 bytes por registro
  18.  
  19.  
  20. Private Canal           As Integer     ' Número de canal de comunicación con el fichero.
  21. Private NumRegistros    As Long
  22. Private reg1            As RegCompra   ' para leer registros
  23. Private reg2            As RegCompra   '  para escribir registro, así diferenciados, será más difícil equivocarnos
  24.  
  25.  
  26. ' Leer Factura
  27. Private Sub Command7_Click()
  28.    If LeerFacturacion("poner aqui tu ruta") = True Then
  29.        ' Activar en la interfaz lo que proceda
  30.    Else
  31.        ' desactivar de la interfaz lo que proceda
  32.    End If
  33.    ' 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'
  34. End Sub
  35.  
  36. Private Function LeerFacturacion(ByRef Ruta As String) As Boolean
  37.    Dim k As Integer
  38.  
  39.    If (Abrir(Ruta) = True) Then
  40.        Get #Canal, 1, NumRegistros
  41.  
  42.        For k = 1 To NumRegistros
  43.            Get #Canal, , reg1
  44.            Call List1.AddItem(SerializarRegistro(reg1))
  45.        Next
  46.        ' Ahora si se quiere puede leerse de nuevo el primer registro para transferirlo a los textbox...
  47.        list1.listindex = 0 ' para ello delegamos en el código que pondremos al listbox...
  48.    End If
  49. End Function
  50.  
  51. Private Sub TrasferirRegToTextbox(ByRef R As RegCompra)
  52.    With R
  53.        txtNumTicket.Text = .NumTicket
  54.        txtFechaComprar.Text = CStr(.fecha)
  55.        optMetodoPago(.MetodoDePago).Value = True  ' 2 controles option con indices 0 y 1
  56.        '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'.
  57.        txtProducto.Text = .Producto
  58.        txtPrecioUnidad.Text = CStr(.PrecioUnidad)
  59.        txtCantidad.Text = CStr(.Cantidad)
  60.        txtSubtotal.Text = CStr(.SubTotal)
  61.    End With
  62. End Sub
  63.  
  64. Private Sub PosicionarRegistro(ByVal Numregistro As Long)
  65.    If (Abierto = True) Then
  66.        Seek (Canal), (1 + ((Numregistro-1) * LenB(reg1)))
  67.    End If
  68. End Sub
  69.  
  70. Private Function SerializarRegistro(ByRef Registro As RegCompra, ByVal Separador As String) As String
  71.    With Registro
  72.        SerializarRegistro = CStr(.NumTicket) & Separador & CStr(.FechaCompra) & _
  73.               Separador & GetMetodoPago(.MetodoDePago) & Separador & .Producto & _
  74.               Separador & CStr(.Cantidad) & Separador & CStr(.PrecioUnidad) & Separador & CStr(.SubTotal)
  75.    End With
  76. End Function
  77.  
  78. Private Function GetMetodoPago(ByVal Metodo As MetodosDePago) As String
  79.    If (Metodo = PAGO_AL_CONTRADO) Then
  80.        GetMetodoPago = "Contado"
  81.    Else
  82.        GetMetodoPago = "T. Credito"
  83.    End If
  84. End Function
  85.  
  86.  
  87. Private Function ExisteFichero(ByRef Ruta As String) As Boolean
  88.    Dim j As Integer, file As String
  89.  
  90.    j = InStrRev(Ruta, "\")
  91.    If (j > 0) Then
  92.        file = LCase$(Right$(Ruta, Len(Ruta) - j))
  93.        ExisteFichero = (LCase$(Dir(Ruta, vbNormal)) = file)
  94.    End If
  95. End Function
  96.  
  97. Private Function Abrir(ByRef Ruta As String) As Boolean
  98.    If (Abierto = True) Then Call Cerrar
  99.  
  100.    If (ExisteFichero(Ruta) = True) Then
  101.        Canal = FreeFile
  102.        On Error GoTo FalloApertura
  103.        Open Ruta For Binary As #Canal
  104.  
  105. FalloApertura:
  106.        If (Err.Number > 0) Then
  107.            Call MsgBox("Error al intentar abrir el fichero en la ruta:" & vbCrLf & Ruta & vbCrLf & Err.Description, vbInformation, "Error de apertura:")
  108.            Err.Clear
  109.        Else
  110.            Abrir = True
  111.        End If
  112.  
  113.        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)...
  114.    End If
  115. End Function
  116.  
  117. Public Property Get Abierto() As Boolean
  118.    Abierto = (Canal > 0)
  119. End Property
  120.  
  121. Private Function Cerrar()
  122.    Close #Canal
  123.    canal = 0
  124.    NumRegistros = 0
  125.  
  126.    ' desactivar de la interfaz lo que proceda...
  127. End Function
  128.  
  129. Private Sub List1_Click()
  130.    If (Abierto = True) Then
  131.        Call PosicionarRegistro(List1.ListIndex + 1)
  132.        Get #Canal, , reg1
  133.        Call TrasferirRegToTextbox(reg1, vbtab)
  134.    End If
  135. End Sub
  136.  
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...


« Última modificación: 24 Noviembre 2021, 01:18 am por Serapis » En línea

corlo

Desconectado Desconectado

Mensajes: 53


Ver Perfil
Re: leer datos en archivo secuencial
« Respuesta #2 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()


Código
  1.  
  2. Private Sub Command7_Click()
  3.    If LeerFacturacion("poner aqui tu ruta") = True Then
  4.        ' Activar en la interfaz lo que proceda
  5.    Else
  6.        ' desactivar de la interfaz lo que proceda
  7.    End If
  8.    ' 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'
  9. End Sub
  10.  
  11.  
  12.  
  13. en donde dices, activar en la interfaz lo que proceda
  14.  
  15.  
  16. supongo que es
  17.  
  18. [code=vb]
  19.  
  20. abierto=true
  21.  
  22.  

en donde dices , desactivar de la interfaz lo que proceda

Código
  1. abierto=false
  2.  
  3.  



y lo segundo cuando haces el private sub posicionarregistro la variable lenb(reg1) que significa


Código
  1.  
  2. Private Sub PosicionarRegistro(ByVal Numregistro As Long)
  3.    If (Abierto = True) Then
  4.        Seek (Canal), (1 + ((Numregistro-1) * LenB(reg1)))
  5.    End If
  6. End Sub
  7.  
  8.  


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]
En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 2.865


Ver Perfil
Re: leer datos en archivo secuencial
« Respuesta #3 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).

Citar
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:
Citar
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:
Código:
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.

Código
  1. Private Enum MetodosDePago
  2.   PAGO_AL_CONTRADO = 0
  3.   PAGO_CON_TCREDITO = 1
  4. End Enum
  5.  
  6. Private Type RegCompra
  7.    NumTicket                       As Integer      ' 1
  8.    FechaCompra                     As Date         ' 3
  9.    MetodoDePago                    As Byte         ' 11
  10.    Alineacion                      As Byte         ' 12 nada solo hace que el registro sea una cantidad par, para ser más efectivo en lecturas
  11.  
  12.    Producto                        As String * 12  ' 13
  13.    PrecioUnidad                    As Single       ' 25
  14.    Cantidad                        As Integer      ' 29
  15.    SubTotal                        As Single       ' 31
  16. End Type                                            ' total: 34 bytes por registro
  17.  
  18. Private Const DIR_COMIENZO_REGS     As Long = 9     ' 1+4+4
  19.  
  20. Private NumRegistros                As Long
  21. Private AutonIncRegs                As Long
  22. '
  23. Private Canal                       As Integer     ' Número de canal de comunicación con el fichero.
  24. Private reg1                        As RegCompra   ' para leer registros
  25. Private reg2                        As RegCompra   '  para escribir registro, así diferenciados, será más difícil equivocarnos
  26.  
  27.  
  28.  
  29.  
  30. Private Sub ComNuevaFacturacion_Click()
  31.    If (Len(TxtFile.Text) > 0) Then
  32.        Call CrearNuevaFacturacion(TxtFile.Text)
  33.    End If
  34. End Sub
  35.  
  36. Private Sub ComAbrirFacturacion_Click()
  37.    Form2.Show 1
  38.  
  39.    If (Len(Form2.File) > 0) Then
  40.        If (LeerFacturacion(App.Path & "\" & Form2.File) = True) Then
  41.            Call Activar(True)
  42.        Else
  43.            Call Activar(False)
  44.        End If
  45.    End If
  46. End Sub
  47.  
  48. Private Sub ComBuscar_Click()
  49.    '
  50. End Sub
  51.  
  52. Private Sub ComEditarRegistro_Click()
  53.    '
  54. End Sub
  55.  
  56. Private Sub ComGuardarRegistro_Click()
  57.    '
  58. End Sub
  59.  
  60. Private Sub ComRetirarRegistro_Click()
  61.    '
  62. End Sub
  63.  
  64. Private Sub ComSalir_Click()
  65.    '
  66. End Sub
  67.  
  68. Private Sub List1_Click()
  69.    If (Abierto = True) Then
  70.        Call PosicionarRegistro(List1.ListIndex + 1)
  71.        Get #Canal, , reg1
  72.        Call TrasferirRegToTextbox(reg1, vbTab)
  73.    End If
  74. End Sub
  75.  
  76.  
  77. ' ------------ Fin interfaz ------------------
  78.  
  79. Private Function LeerFacturacion(ByRef Ruta As String) As Boolean
  80.    Dim k As Integer
  81.  
  82.    If (Abrir(Ruta) = True) Then
  83.        Get #Canal, 1, NumRegistros
  84.  
  85.        For k = 1 To NumRegistros
  86.            Get #Canal, , reg1
  87.            Call List1.AddItem(SerializarRegistro(reg1))
  88.        Next
  89.        ' Ahora si se quiere puede leerse de nuevo el primer registro para transferirlo a los textbox...
  90.        List1.ListIndex = 0 ' para ello delegamos en el código que pondremos al listbox...
  91.    End If
  92. End Function
  93.  
  94. Private Sub TrasferirRegToTextbox(ByRef R As RegCompra)
  95.    With R
  96.        txtNumTicket.Text = .NumTicket
  97.        txtFechaComprar.Text = CStr(.fecha)
  98.        optMetodoPago(.MetodoDePago).Value = True  ' 2 controles option con indices 0 y 1
  99.        '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'.
  100.        txtProducto.Text = .Producto
  101.        txtPrecioUnidad.Text = CStr(.PrecioUnidad)
  102.        txtCantidad.Text = CStr(.Cantidad)
  103.        txtSubtotal.Text = CStr(.SubTotal)
  104.    End With
  105. End Sub
  106.  
  107. Private Sub PosicionarRegistro(ByVal Numregistro As Long)
  108.    If (Abierto = True) Then
  109.        Seek (Canal), (DIR_COMIENZO_REGS + ((Numregistro - 1) * LenB(reg1)))
  110.    End If
  111. End Sub
  112.  
  113. Private Function SerializarRegistro(ByRef Registro As RegCompra, ByVal Separador As String) As String
  114.    With Registro
  115.        SerializarRegistro = CStr(.NumTicket) & Separador & CStr(.FechaCompra) & _
  116.               Separador & GetMetodoPago(.MetodoDePago) & Separador & .Producto & _
  117.               Separador & CStr(.Cantidad) & Separador & CStr(.PrecioUnidad) & Separador & CStr(.SubTotal)
  118.    End With
  119. End Function
  120.  
  121. Private Function GetMetodoPago(ByVal Metodo As MetodosDePago) As String
  122.    If (Metodo = PAGO_AL_CONTRADO) Then
  123.        GetMetodoPago = "Contado"
  124.    Else
  125.        GetMetodoPago = "T. Credito"
  126.    End If
  127. End Function
  128.  
  129.  
  130. Private Function ExisteFichero(ByRef Ruta As String) As Boolean
  131.    Dim j As Integer, File As String
  132.  
  133.    j = InStrRev(Ruta, "\")
  134.    If (j > 0) Then
  135.        File = LCase$(Right$(Ruta, Len(Ruta) - j))
  136.        ExisteFichero = (LCase$(Dir(Ruta, vbNormal)) = File)
  137.    End If
  138. End Function
  139.  
  140. ' Abre un fichero que YA EXISTE: Cuando se solicita leer la facturación de uno.
  141. ' Abre un fichero que NO EXISTE: Cuando se trata de crear una nueva facturación.
  142. Private Function Abrir(ByRef Ruta As String, Optional ByVal NoDebeExistir As Boolean = False) As Boolean
  143.    If (Abierto = True) Then Call Cerrar
  144.  
  145.    If (ExisteFichero(Ruta) = False) Then
  146.        If (NoDebeExistir = False) Then Exit Function
  147.    End If
  148.  
  149.    Canal = FreeFile
  150.    On Error GoTo FalloApertura
  151.    Open Ruta For Binary As #Canal
  152.  
  153. FalloApertura:
  154.    If (Err.Number > 0) Then
  155.        Call MsgBox("Error al intentar abrir el fichero en la ruta:" & vbCrLf & Ruta & vbCrLf & Err.Description, vbInformation, "Error de apertura:")
  156.        Err.Clear
  157.    Else
  158.        Abrir = True
  159.    End If
  160.  
  161.    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)...
  162. End Function
  163.  
  164. Public Property Get Abierto() As Boolean
  165.    Abierto = (Canal > 0)
  166. End Property
  167.  
  168. Private Function Cerrar()
  169.    Close #Canal
  170.    Canal = 0
  171.    NumRegistros = 0
  172.  
  173.    ' desactivar de la interfaz lo que proceda...
  174. End Function
  175.  
  176.  
  177. ' -------------------------------------------------
  178. ' -------- NUEVO DESDe AQUI ---------------
  179. '--------------------------------------------------
  180. ' Index refiere al enésimo registor en el fichero.
  181. ' Si es -1 refiere al último, lo adecuaod cuando se añade.
  182. ' Si es entre 1 y NumRegistros, señala que es un registro que se ha editado...
  183. Private Sub GuardarRegistro(ByRef R As RegCompra, Optional ByVal Index As Long = -1)
  184.    If (R.NumTicket = 0) Then
  185.        AutonIncRegs = (AutonIncRegs + 1)
  186.        R.NumTicket = AutonIncRegs
  187.    End If
  188.  
  189.    '
  190.    If (Index = -1) Then
  191.        NumRegistros = (NumRegistros + 1)
  192.        Index = NumRegistros
  193.    End If
  194.  
  195.    Call PosicionarRegistro(Index)
  196.    Put #Canal, , R                                 ' Guarda el registro
  197.    Put #Canal, 1, NumRegistros                     ' Guarda la cantidad de registros
  198.    Put #Canal, , AutonIncRegs                      ' Guarda el valor de autoincrmeento (es un valor único).
  199. End Sub
  200.  
  201. Private Function CrearNuevaFacturacion(ByRef NombreFile As String) As Boolean
  202.    Dim Ruta As String
  203.  
  204.    Ruta = App.Path & "\" & NombreFile
  205.    If (Abrir(Ruta, True) = True) Then
  206.        NumRegistros = 0: AutonIncRegs = 0
  207.        Put #Canal, 1, NumRegistros                 ' Guarda la cantidad de registros
  208.        Put #Canal, , AutonIncRegs                  ' Guarda el valor de autoincrmeento (es un valor único).
  209.  
  210.        CrearNuevaFacturacion = True
  211.    Else
  212.        MsgBox "Parece que el fichero que intenta abrir ya existe, elija otro nombre (o bien ocurrió un error)..."
  213.    End If
  214. End Function
  215.  
  216. ' Numreg: Permite seguir buscando más artículos a partir del previo que se encontró...
  217. Private Function BuscarArticulo(ByRef Producto As String, Optional ByRef NumReg As Long = 0) As Boolean
  218.    Dim k As Long, ptr As Long, inc As Long, Articulo As String * 12
  219.  
  220.    If (NumReg < NumRegistros) Then
  221.        NumReg = (NumReg + 1)
  222.        If (NumReg > 1) Then
  223.            Call PosicionarRegistro(NumReg)
  224.            ptr = Seek(Canal) + 12
  225.        Else
  226.            ptr = (DIR_COMIENZO_REGS + 12)                  ' Dir de comienzo de registros + desplazamiento al campo soliicitado.
  227.        End If
  228.  
  229.        Producto = LCase(Producto)
  230.        inc = LenB(reg1)
  231.        For k = NumReg To NumRegistros
  232.            Get #Canal, ptr, Articulo
  233.  
  234.            If (LCase$(Articulo) = Producto) Then
  235.                Get #Canal, ptr - 12, reg1
  236.                BuscarArticulo = True
  237.                Exit For
  238.            End If
  239.            ptr = (ptr + inc)
  240.        Next
  241.  
  242.        NumReg = k
  243.    End If
  244. End Function
  245.  
  246. ' 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).
  247. Private Function BuscarTicket(ByVal Ticket As Long) As Boolean
  248.    Dim k As Long, ptr As Long, inc As Long, nTicket As Long
  249.  
  250.    ptr = DIR_COMIENZO_REGS                     ' Dir de comienzo de registros + desplazamiento al campo soliicitado=0.
  251.    inc = LenB(reg1)
  252.    For k = 1 To NumRegistros
  253.        Get #Canal, ptr, nTicket
  254.  
  255.        If (LCase$(nTicket) = Ticket) Then
  256.            Get #Canal, ptr, reg1
  257.            BuscarTicket= True
  258.            Exit For
  259.        End If
  260.        ptr = (ptr + inc)
  261.    Next
  262. End Function
  263.  


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.
« Última modificación: 25 Noviembre 2021, 02:16 am por Serapis » En línea

corlo

Desconectado Desconectado

Mensajes: 53


Ver Perfil
Re: leer datos en archivo secuencial
« Respuesta #4 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
En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 2.865


Ver Perfil
Re: leer datos en archivo secuencial
« Respuesta #5 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...
« Última modificación: 25 Noviembre 2021, 20:09 pm por Serapis » En línea

corlo

Desconectado Desconectado

Mensajes: 53


Ver Perfil
Re: leer datos en archivo secuencial
« Respuesta #6 en: Ayer a las 22:00 »

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
En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 2.865


Ver Perfil
Re: leer datos en archivo secuencial
« Respuesta #7 en: Ayer a las 23:27 »

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...



Si necesitas alguna aclaración, pregunta.
« Última modificación: Ayer a las 23:34 por Serapis » En línea

corlo

Desconectado Desconectado

Mensajes: 53


Ver Perfil
Re: leer datos en archivo secuencial
« Respuesta #8 en: Hoy a las 00:20 »

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

En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 2.865


Ver Perfil
Re: leer datos en archivo secuencial
« Respuesta #9 en: Hoy a las 02:02 »

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...
Citar
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.
« Última modificación: Hoy a las 02:04 por Serapis » En línea

Páginas: [1] 2 Ir Arriba Respuesta Imprimir 

Ir a:  

WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines