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

 

 


Tema destacado: (TUTORIAL) Aprende a emular Sentinel Dongle By Yapis


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  cambiar contador a uno al dia siguiente
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: cambiar contador a uno al dia siguiente  (Leído 3,625 veces)
corlo

Desconectado Desconectado

Mensajes: 98


Ver Perfil
cambiar contador a uno al dia siguiente
« en: 24 Noviembre 2019, 14:22 pm »

Hola soy Corlo
necesito una ayuda para el siguiente tema
La cuestion es que el siguiente programa que he hecho funciona correctamente, pero el problema que hay es que cuando pasa un dia entero que cambie el contador de n=1 en la caja de texto text1.text y que vaya sumando el contador correlativamente
dejo el codigo


Código:

Option Explicit
Dim n As Integer



Private Sub Command1_Click()
'Nuevo
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)


n = LOF(1) / Len(file)

Get #1, n, file
Text1.Text = n + 1
Close #1

Text2.Text = Format(date, "dd/mm/yyyy")
Text3.Text = ""
Text3.SetFocus
End Sub

Private Sub Command2_Click()
'Guardar
file.id = Text1.Text
file.date = Text2.Text
file.name = Text3.Text

Open App.Path & "\database.txt" For Random As 1 Len = Len(file)

n = LOF(1) / Len(file)
Put #1, n + 1, file
Close #1
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Command4_Click()
Unload Me
Form2.Show
End Sub

Private Sub Form_Load()
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)

n = LOF(1) / Len(file)

Get #1, n, file
Text1.Text = n + 1

Close #1

Text2.Text = Format(date, "dd/mm/yyyy")
End Sub








y en un modulo



Código:

Type Task
id As Integer
date As Date
name As String * 30
End Type


Option Explicit
Global file As Task








Gracias





En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 3.348


Ver Perfil
Re: cambiar contador a uno al dia siguiente
« Respuesta #1 en: 27 Noviembre 2019, 15:05 pm »

Tu problema básico es que la siguiente línea es incorrecta.:


Código
  1. n = LOF(1) / Len(file)
  2.  

En tu ' load', necesitas añadir esta línea:
Código
  1. Private Sub Form_Load()
  2.     '...
  3.  
  4.    ' lo que mide un registro en bytes:
  5.    sizeTask = len(file) ' medir una instancia de la estructura task, file es un a instancia.
  6.  
  7.  
  8.    ' la cantidad de registros que tiene el fichero:  
  9.    n = (filelen(ruta)\sizeTask)   ' solo para esto... no hace falta abrir el fichero...
  10.  
  11.    '...
  12. end sub
  13.  

- Incrementa 'n' solo cuando añadas un registro, no cuando sobrescribas alguno existente.

- No he mirado a fondo el código, pero no veo la necesidad de pasar 'n' a un 'textbox' y viceveersa, en todo caso usa un control numérico como puede ser un 'scroll'... cuando añades un registro, añade en la posición que señala la propiedasd max del scroll. después de añadido (si no hubo problemas) cambias la propiedad 'max' del scroll (suma 1) después de crearlo. Para leer lee el el registro de la propiedad 'value' del scroll, etc...

- Procede dar nombres más consistentes a las variables que simplemente 'n'... muchos mejopr 'regNum' por ejemplo si no quieres 'gastar muchos caracteres'...

- De hecho usando directamente las propedades del scroll, no es preciso usar 'n', pasando a llamar al scroll algo como 'scrollPosRegistro' (por ejemplo). Y por tanto cambiando la asignación en el load de 'n' a 'scrollPosRegistro'.max = 'filelen'\'size1reg'

- La ruta del fichero, llámala así:
Código
  1. dim ruta as string   ' en el formulario
  2.  
  3. ruta = "...."  ' en el load... y usas 'ruta cada vez que debas abrir el fichero en vez de la ruta completa (pués esta no varía).
  4.  

- Si operas siempre con el mismo fichero en toda la sesión, procede abrir el fichero durante la carga de la aplicación y cerrarlo al cerrar la aplicación, en vez de abrir y cerrar contínuamente...


« Última modificación: 27 Noviembre 2019, 15:18 pm por NEBIRE » En línea

corlo

Desconectado Desconectado

Mensajes: 98


Ver Perfil
Re: cambiar contador a uno al dia siguiente
« Respuesta #2 en: 27 Noviembre 2019, 20:43 pm »

Hola soy Corlo
Gracias por responder Nebire
lo del control numerico scroll, no lo entiendo,
el objeto en poner al formulario es vscroll1 o hscroll1
me podrias poner en un ejemplo con codigo
gracias
En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 3.348


Ver Perfil
Re: cambiar contador a uno al dia siguiente
« Respuesta #3 en: 27 Noviembre 2019, 21:08 pm »

Claro... posiblemente mañana jueves (si no saco un tiempito esta noche) te pongo un sencillo ejemplo que puedas despiezar, deglutir y modificar a tu antojo.

No importa si pones un scroll vertical u horizontal, aunque el horizontal se presta mejor a poner algún 'label' que refleje su cometido incluso un 'numericUpDown', vale perfectamente.
En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 3.348


Ver Perfil
Re: cambiar contador a uno al dia siguiente
« Respuesta #4 en: 28 Noviembre 2019, 00:32 am »

He sacado un tiempito rápido... quizás se haya escapado algún gazapo, pués no lo he probado... queda a tu esfuerzo corregirlos, si los hubiere.

Como desconozco la interfaz que tengas, yo he optado por un sencillo menú, con 4 opciones:
- Nuevo
- Leer
- Editar
- Borrar
Este formulario principal, no tiene nada más en la interfaz.
Hay dos ventanas adicionales, una para elegir el índice de registro y otra para mostrar/editar los valores de la estructura.
Para la fecha he elegido un control DateTimePicker... que actúa como un combobox, que al desplegar muestra un calendario...

Te pongo el código y luego adjunto un enlace de descarga...

En el módulo, yace solo la estructura y una enumeración de las acciones:
Código
  1. Public Type Task
  2.    Id                  As Integer
  3.    Date                As Date
  4.    Name                As String * 30
  5. End Type
  6.  
  7. Public Enum Acciones
  8.    ACCION_NUEVO = 0
  9.    ACCION_LEER = 1
  10.    ACCION_EDITAR = 2
  11.    ACCION_BORRAR = 3
  12. End Enum
  13.  

La ventana principal:
Código
  1. Dim Ruta                As String
  2. Dim Numregs             As Long
  3. Dim Canal               As Integer
  4. Dim LenRegTask          As Integer
  5. ' Dim file               As Task
  6.  
  7.  
  8.  
  9.  
  10.  
  11. Private Sub Form_Load()
  12.    Dim tk As Task
  13.    LenRegTask = Len(tk)
  14.  
  15.    Ruta = App.Path & "\database.txt"
  16.    Call AbriBaseDatos
  17.  
  18.    If (Numregs > 0) Then
  19.        ' mostrar el primero:
  20.  
  21.    End If
  22. End Sub
  23.    Private Sub Form_Terminate()
  24.        Close #Canal
  25.    End Sub
  26.  
  27. Private Sub mnuRegistro_Click(Index As Integer)
  28.    Dim tk As Task
  29.    Dim Ix As Long
  30.  
  31.    Select Case Index
  32.        Case 0 ' nuevo registro
  33.            With frmRegistro          ' crear el registro
  34.                .Titulo = "Nuevo"
  35.                .Accion = ACCION_NUEVO
  36.                .Show 1
  37.  
  38.                ' guardarlo al final...
  39.                If (.Aceptado = True) Then
  40.                    tk.Id = .Id
  41.                    tk.Name = .Nombre
  42.                    tk.Date = .Fecha
  43.  
  44.                    Seek (Canal), (LOF(Canal) + 1)
  45.                    Put #Canal, , tk
  46.  
  47.                    Numregs = (Numregs + 1)
  48.                End If
  49.            End With
  50.  
  51.        Case 1 ' Leer Registro
  52.            Ix = GetIndiceReg
  53.            If (Ix >= 0) Then
  54.                Seek (Canal), ((Ix * LenRegTask) + 1)
  55.                Get #Canal, , tk
  56.  
  57.                With frmRegistro       ' exponer  el registro
  58.                    .Titulo = "Leído"
  59.                    .Accion = ACCION_LEER
  60.                    .Id = tk.Id
  61.                    .Nombre = tk.Name
  62.                    .Fecha = tk.Date
  63.                    .Show 1
  64.                End With
  65.            End If
  66.  
  67.        Case 2 ' Editar registro.
  68.            Ix = GetIndiceReg
  69.            If (Ix >= 0) Then
  70.                Seek (Canal), ((Ix * LenRegTask) + 1)
  71.                Get #Canal, , tk
  72.                With frmRegistro       ' editar registro
  73.                    .Titulo = "Editar"
  74.                    .Accion = ACCION_EDITAR
  75.                    .Id = tk.Id
  76.                    .Nombre = tk.Name
  77.                    .Fecha = tk.Date
  78.                    .Show 1
  79.  
  80.                    ' guardarlo en su posición...
  81.                    If (.Aceptado = True) Then
  82.                        tk.Id = .Id
  83.                        tk.Name = .Nombre
  84.                        tk.Date = .Fecha
  85.  
  86.                        Seek (Canal), ((Ix * LenRegTask) + 1)
  87.                        Put #Canal, , tk
  88.                    End If
  89.                End With
  90.            End If
  91.  
  92.        Case 3 ' Borrar registro.
  93.            Ix = GetIndiceReg
  94.            If (Ix >= 0) Then
  95.                ' confirmar que es el correcto:
  96.                MsgBox "A continuación se mostrarán los datos del registro." & vbCrLf & _
  97.                    "Pulse 'Aceptar' si es el registro que desea borrar o 'Cancelar' si no lo es...", vbInformation
  98.  
  99.                With frmRegistro       ' editar registro
  100.                    .Titulo = "Confirmar"
  101.                    .Accion = ACCION_LEER
  102.                    .Id = tk.Id
  103.                    .Nombre = tk.Name
  104.                    .Fecha = tk.Date
  105.                    .Show 1
  106.  
  107.                    ' borrarlo final...
  108.                    If (.Aceptado = True) Then
  109.                        Call Borrar(Ix)
  110.                    End If
  111.                End With
  112.            End If
  113.    End Select
  114. End Sub
  115.  
  116. ' Solicita el índice del registro...
  117. Private Function GetIndiceReg() As Long
  118.    If (Numregs > 0) Then
  119.        With frmIndiceReg
  120.            .Cantidad = Numregs
  121.            .Show 1
  122.            If (.Aceptado = True) Then
  123.                GetIndiceReg = (.Indice - 1)
  124.            Else
  125.                GetIndiceReg = -1
  126.            End If
  127.        End With
  128.    Else
  129.        GetIndiceReg = -1
  130.    End If
  131. End Function
  132.  
  133. ' Borrar un registro exige bastante esfuerzo y hay diferentes métodos
  134. '  el más sencillo (pero que puede ser costoso en tiempo si el fichero es grande)
  135. '  pasa por copiar los registros activos a otro fichero, eliminar el previo y renombrar el actual.
  136. Private Sub Borrar(ByVal Indice As Long)
  137.    Dim ff As Integer, k As Long
  138.    Dim tk As Task
  139.    Dim temp As String
  140.  
  141.    temp = Replace(Ruta, ".txt", ".tmp")
  142.    ff = FreeFile
  143.    Open temp For Binary As #ff
  144.  
  145.    Seek (Canal), 1
  146.    ' copiar y pegar los registros previos al índice seleccionado
  147.    For k = 0 To Indice - 1
  148.        Get #Canal, , tk
  149.        Put #ff, , tk
  150.    Next
  151.  
  152.    ' saltamos el registro a borrar
  153.  
  154.    ' copiar y pegar los registros tras el índice seleccionado
  155.    For k = Indice + 1 To Numregs
  156.        Get #Canal, , tk
  157.        Put #ff, , tk
  158.    Next
  159.  
  160.    Close                   ' cierra ambos ficheros
  161.    Kill Ruta               ' elimina el actual
  162.    Name temp As Ruta       ' renombra el creado como el actual
  163.    Call AbriBaseDatos      ' y lo abre como actual
  164. End Sub
  165.  
  166. Private Sub AbriBaseDatos()
  167.    Canal = FreeFile
  168.  
  169.    On Error GoTo falloFile
  170.    Open Ruta For Binary As #Canal
  171.    Numregs = (FileLen(Ruta) \ LenRegTask)
  172.  
  173.    Exit Sub
  174. falloFile:
  175.    Call MsgBox("Ocurrió un eror inesperado: " & CStr(Err.Number) & vbCrLf & _
  176.        "Mensaje: " & Err.Description & vbCrLf & _
  177.        "Se cerrará la aplicación...", vbCritical, "Error inesperado durante la apertura dle fichero")
  178.    Err.Clear
  179.    Unload Me
  180. End Sub
  181.  

La ventana de selección de índice:
Código
  1. Public Aceptado As Boolean
  2.  
  3. Public Property Get Indice() As Integer
  4.    Indice = HScrRegistros.Value
  5. End Property
  6.    Public Property Let Indice(ByVal X As Integer)
  7.        HScrRegistros.Value = X
  8.    End Property
  9.  
  10. Public Property Get Cantidad() As Integer
  11.    Cantidad = HScrRegistros.Max
  12. End Property
  13.    Public Property Let Cantidad(ByVal X As Integer)
  14.        HScrRegistros.Max = X
  15.    End Property
  16.  
  17.  
  18.  
  19.  
  20.  
  21.  
  22.  
  23. Private Sub Form_Load()
  24.    HScrRegistros.Min = 1
  25.    Aceptado = False
  26. End Sub
  27.  
  28. Private Sub HScrRegistros_Change()
  29.    Me.Caption = "Indice de registro: " & CStr(HScrRegistros.Value)
  30. End Sub
  31.  
  32. Private Sub ComCancelar_Click()
  33.    Me.Hide
  34. End Sub
  35.  
  36. Private Sub ComAceptar_Click()
  37.    Aceptado = True
  38.    Me.Hide
  39. End Sub
  40.  
  41.  

La ventana de edición de la estructura:
Código
  1. Public Aceptado As Boolean
  2.  
  3.  
  4.  
  5. Public Property Let Titulo(ByRef X As String)
  6.    Me.Caption = "Registro: " & X
  7. End Property
  8. Public Property Let Accion(ByVal X As Acciones)
  9.    Dim b As Boolean
  10.  
  11.    b = Not (X = ACCION_LEER)
  12.  
  13.    HScrId.Enabled = b
  14.    TxtName.Enabled = b
  15.    dtpFecha.Enabled = b
  16. End Property
  17.  
  18.  
  19. Public Property Get Id() As Integer
  20.    Id = Me.HScrId.Value
  21. End Property
  22.    Public Property Let Id(ByVal X As Integer)
  23.        Me.HScrId.Value = X
  24.    End Property
  25.  
  26. Public Property Get Nombre() As String
  27.    Nombre = Me.TxtName.Text
  28. End Property
  29.    Public Property Let Nombre(ByRef X As String)
  30.        Me.TxtName.Text = X
  31.    End Property
  32.  
  33. Public Property Get Fecha() As Date
  34.    Fecha = dtpFecha.Value
  35. End Property
  36.    Public Property Let Fecha(ByRef X As Date)
  37.        dtpFecha.Value = X
  38.    End Property
  39.  
  40.  
  41.  
  42.  
  43.  
  44.  
  45. Private Sub ComCancelar_Click()
  46.    Me.Hide
  47. End Sub
  48.  
  49. Private Sub ComAceptar_Click()
  50.    Aceptado = True
  51.    Me.Hide
  52. End Sub
  53.  
  54. Private Sub Form_Load()
  55.    HScrId.LargeChange = 100
  56.    TxtName.MaxLength = 30 ' para que coincida con el campo Task.Name , en realidad puede hacerse sobre la interfaz en diseño.
  57.    Aceptado = False
  58. End Sub
  59.  
  60. Private Sub HScrId_Change()
  61.    LabId.Caption = "Id: " & CStr(HScrId.Value)
  62. End Sub
  63.  

Por supuesto se puede hacer más simple y espagueti, pero así como mínimo te resultará muy fácil de ampliar... y tampoco resulta complejo que dificulte entenderlo.

Ejecútalo paso a paso con a tecla F8... para ir mirando donde te pudiera costar entender algo. Con cualquier duda, pregunta.

Descarga del proyecto:
https://workupload.com/file/bU8u4LZY

Alguna imagen de como se ve...


En línea

corlo

Desconectado Desconectado

Mensajes: 98


Ver Perfil
Re: cambiar contador a uno al dia siguiente
« Respuesta #5 en: 28 Noviembre 2019, 13:37 pm »

Hola soy Corlo
muchas gracias Nebire por tu codigo me ha servido de mucha ayuda, muchisimas gracias.
En línea

corlo

Desconectado Desconectado

Mensajes: 98


Ver Perfil
Re: cambiar contador a uno al dia siguiente
« Respuesta #6 en: 1 Diciembre 2019, 16:07 pm »

Hola soy Corlo
tengo una duda del programa
a la hora de entrar nuevo registro funciona bien, pero cuando sales del programa y vuelves ha entrar no te dice los datos introducidos anteriormente del fichero database.txt, te vuelve a entrar id=1.
¿como seria actualizar el valor id del fichero database.txt?
gracias 
En línea

Serapis
Colaborador
***
Desconectado Desconectado

Mensajes: 3.348


Ver Perfil
Re: cambiar contador a uno al dia siguiente
« Respuesta #7 en: 1 Diciembre 2019, 21:13 pm »

El 'id', tal como lo puse, no es un valor correlativo, sino un dato numérico asociado al 'task'. Cada registro es añadido secuencialmente.

Cuando eliges 'leer' o 'editar' te pide elegir 1 registro entre 1 y la cantidad total que tenga, después que eliges que registro leer, se lee. El Id, es el valor que tuviere el registro... el valor que que tú pusieras cuando editaste/creaste el registro...

Igual que eliges una fecha y escribes un nombre tienes que variar el scroll para que el id tenga un valor numérico que tu quieras, si no será el que tenga por defecto el scroll al cargar la ventana (igual que el nombre por defecto será una cadena vacía y la fecha por defecto será 'hoy').

Contempla esta imagen, y observa como en Id, figura 903, porque al crear/editar el registro ese  es el valor elegido/modificado. Si al crear el registro no modificas ese valor tendrá el valor por defecto (no recuerod si 0 ó 1), lo mismo si no escribes un nombre, quedará en blanco...


Siempre puedes bloquear el botón 'Aceptar', supeditado a que los campos tengan un valor coherente... para el texto es fácil, pués basta verificar que no es una cadena vacía, para el id, podría al entrar ponerse el valor -1 y por tanto validaría cuando fuera un valor mayor o igual que 0 ...

...tampoco sé el rango de valores aceptables para lo que necesites. Es un ejemplo que tú debes adaptar a tus necesidades, yo no puedo (ni nadie), crear un ejemplo que coincida plenamente con lo que tú necesites. El ejemplo te muestra lo sufieinte para que tu puedas entenderlo y modificarlo a tu gusto...

Si a pesar de todo hay algo específico que no sepas como hacer, explícate bien (que se entienda, no que uno juegue a adivinar) y vería de readaptar el código...
 
« Última modificación: 1 Diciembre 2019, 21:17 pm por NEBIRE » En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Siguiente paso
Hacking
spinaca 7 3,843 Último mensaje 27 Marzo 2014, 18:04 pm
por engel lex
No entiendo lo siguiente en c#
.NET (C#, VB.NET, ASP)
andrecid 2 1,680 Último mensaje 12 Agosto 2014, 15:43 pm
por Eleкtro
Si usas Windows 10, con la siguiente actualización tu navegador va a cambiar
Windows
Machacador 0 1,778 Último mensaje 19 Diciembre 2019, 00:16 am
por Machacador
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines