'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...        es.geocities.com/jm00092
'
'______________________________________________________________________
'           
DECLARE SUB Compacta ()
DECLARE SUB AbreArchivo (archivo$)
DECLARE SUB Modifica ()
DECLARE SUB Listado ()
DECLARE SUB BuscaDireccion ()
DECLARE SUB BuscaTelefono ()
DECLARE SUB BuscaEdad ()
DECLARE SUB Borra ()
DECLARE SUB Nuevo ()
DECLARE SUB BuscaNombre ()
DECLARE SUB PintaMenu ()

TYPE tipopersona
   nombre AS STRING * 20
   direccion AS STRING * 30
   telefono AS STRING * 9
   edad AS INTEGER
END TYPE


AbreArchivo "Agenda.dat"

DO
   PintaMenu
   WHILE INKEY$ <> "": WEND 'Para limpiar INKEY$
   DO
      tecla$ = UCASE$(INKEY$)'Transforma a may£sculas para evitar confusiones
   LOOP WHILE tecla$ = ""    'Espera activa mientras no pulsemos una tecla

   SELECT CASE tecla$
      CASE "A": Nuevo
      CASE "B": Borra
      CASE "M": Modifica
      CASE "N": BuscaNombre
      CASE "D": BuscaDireccion
      CASE "T": BuscaTelefono
      CASE "E": BuscaEdad
      CASE "L": Listado
      CASE "C": Compacta
      CASE "S"  'Aqui no hacemos nada poque ya vamos a salir del bucle
      CASE ELSE: BEEP 'Toque de timbre si puls¢ tecla no v lida
   END SELECT
LOOP UNTIL tecla$ = "S"

CLOSE #1

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'           
'Abre el archivo que le pasamos como par metro y le asigna un descriptor
'usado FREEFILE que devuelve el pr¢ximo disponible.
'
SUB AbreArchivo (archivo$)

DIM registro AS tipopersona
OPEN archivo$ FOR RANDOM AS FREEFILE LEN = LEN(registro)

END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'           
SUB Borra
  
   DIM persona AS tipopersona
  
   numregS = (LOF(1) / LEN(persona)) 'Calculamos cuantos registros hay
  
   CLS
   PRINT , "BORRAR PERSONA"
   PRINT
  
   IF numregS = 0 THEN
      PRINT "Base de datos vac¡a"
   ELSE

      INPUT "N£mero de registro a borrar: ", numborrar%
      PRINT
     
      IF numborrar% < 1 OR numborrar% > numregS THEN

         PRINT "N£mero de registro incorrecto"
         PRINT "Tiene que ser entre 1 y"; numregS

      ELSE

         GET #1, numborrar%, persona
        
         PRINT "Nombre.....: "; persona.nombre
         PRINT "Direcci¢n..: "; persona.direccion
         PRINT "Tel‚fono...: "; persona.telefono
         PRINT "Edad.......:"; persona.edad
         PRINT
         PRINT "¨Seguro que quieres borrar este registro? (S/N)"
         PRINT
        
         WHILE INKEY$ <> "": WEND 'Para limpiar INKEY$
        
         DO
            tecla$ = UCASE$(INKEY$)               'Transforma a may£sculas
         LOOP UNTIL tecla$ = "S" OR tecla$ = "N"  'Espera hasta que pulsemos S ¢ N
        
         IF tecla$ = "S" THEN
            'rellena el registro con espacios o -1 (Edad imposible) seg£n sea texto o numero
            persona.nombre = SPACE$(LEN(persona.nombre))
            persona.direccion = SPACE$(LEN(persona.direccion))
            persona.telefono = SPACE$(LEN(persona.telefono))
            persona.edad = -1
            'Graba en el fichero
            PUT #1, numborrar%, persona
            PRINT "El egistro ya se ha borrado"
         ELSE
            PRINT "No se ha borrado"
         END IF
      END IF
   END IF
  
   SLEEP 'Esperamos a que pulse una tecla

END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'           
SUB BuscaDireccion
   DIM persona AS tipopersona
   numregS = (LOF(1) / LEN(persona)) 'Calculamos cuantos registros hay
   CLS
   PRINT , "BUSQUEDA POR DIRECCI¢N"
   PRINT
   IF numregS = 0 THEN
      PRINT "Base de datos vac¡a"
   ELSE
      INPUT "Direcci¢n a buscar: ", dirBuscada$
      n = 1
      DO
         GET #1, n, persona
         n = n + 1
      LOOP UNTIL RTRIM$(persona.direccion) = dirBuscada$ OR n > numregS
      'Avanzamos hasta que la encontremos o hasta que no haya m s registros
      PRINT
      IF n <= numregS THEN 'Si no se ha superado al final del fichero
         PRINT "Encontrado en registro"; n - 1'Restamos porque antes se sum¢
         PRINT
         PRINT "Nombre.....: "; persona.nombre
         PRINT "Direcci¢n..: "; persona.direccion
         PRINT "Tel‚fono...: "; persona.telefono
         PRINT "Edad.......:"; persona.edad
      ELSE
         PRINT "No se ha encontrado"
      END IF
   END IF
   SLEEP 'Esperamos a que pulse una tecla
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'           
SUB BuscaEdad
   DIM persona AS tipopersona
   numregS = (LOF(1) / LEN(persona)) 'Calculamos cuantos registros hay
   CLS
   PRINT , "BUSQUEDA POR EDAD"
   PRINT
   IF numregS = 0 THEN
      PRINT "Base de datos vac¡a"
   ELSE
      INPUT "Edad a buscar: ", edadBuscada%
      n = 1
      DO
         GET #1, n, persona
         n = n + 1
      LOOP UNTIL persona.edad = edadBuscada% OR n > numregS
      'Avanzamos hasta que lo encontremos o hasta que no haya m s registros
      PRINT
      IF n <= numregS THEN 'Si no se ha superado al final del fichero
         PRINT "Encontrado en registro"; n - 1 'Restamos porque antes se sum¢
         PRINT
         PRINT "Nombre.....: "; persona.nombre
         PRINT "Direcci¢n..: "; persona.direccion
         PRINT "Tel‚fono...: "; persona.telefono
         PRINT "Edad.......:"; persona.edad
      ELSE
         PRINT "No se ha encontrado"
      END IF
   END IF
   SLEEP 'Esperamos a que pulse una tecla
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'           
SUB BuscaNombre
   DIM persona AS tipopersona
   numregS = (LOF(1) / LEN(persona)) 'Calculamos cuantos registros hay
   CLS
   PRINT , "BUSQUEDA POR NOMBRE"
   PRINT
   IF numregS = 0 THEN
      PRINT "Base de datos vac¡a"
   ELSE
      INPUT "Nombre a buscar: ", nombreBuscado$
      n = 1
      DO
         GET #1, n, persona
         n = n + 1
      LOOP UNTIL RTRIM$(persona.nombre) = nombreBuscado$ OR n > numregS
      'Avanzamos hasta que lo encontremos o hasta que no haya m s registros
      PRINT
      IF n <= numregS THEN 'Si no se ha superado al final del fichero
         PRINT "Encontrado en registro"; n - 1 'Restamos porque antes se sum¢
         PRINT
         PRINT "Nombre.....: "; persona.nombre
         PRINT "Direcci¢n..: "; persona.direccion
         PRINT "Tel‚fono...: "; persona.telefono
         PRINT "Edad.......:"; persona.edad
      ELSE
         PRINT "No se ha encontrado"
      END IF
   END IF
   SLEEP 'Esperamos a que pulse una tecla
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'           
SUB BuscaTelefono
   DIM persona AS tipopersona
   numregS = (LOF(1) / LEN(persona)) 'Calculamos cuantos registros hay
   CLS
   PRINT , "BUSQUEDA POR TEL�FONO"
   PRINT
   IF numregS = 0 THEN
      PRINT "Base de datos vac¡a"
   ELSE
      INPUT "Tel‚fono a buscar: ", telBuscado$
      n = 1
      DO
         GET #1, n, persona
         n = n + 1
      LOOP UNTIL RTRIM$(persona.telefono) = telBuscado$ OR n > numregS
      'Avanzamos hasta que lo encontremos o hasta que no haya m s registros
      PRINT
      IF n <= numregS THEN 'Si no se ha superado al final del fichero
         PRINT "Encontrado en registro"; n - 1 'Restamos porque antes se sum¢
         PRINT
         PRINT "Nombre.....: "; persona.nombre
         PRINT "Direcci¢n..: "; persona.direccion
         PRINT "Tel‚fono...: "; persona.telefono
         PRINT "Edad.......:"; persona.edad
      ELSE
         PRINT "No se ha encontrado"
      END IF
   END IF
   SLEEP 'Esperamos a que pulse una tecla
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'           
SUB Compacta
   DIM registro AS tipopersona
   numregS = (LOF(1) / LEN(registro)) 'Calculamos cuantos registros hay

   AbreArchivo "Agenda.tmp" 'Creamos archivo temporal para ir copiando
                            'registros si no est n borrados y quedarnos
                            'solo con los que sirven.
   CLS
   PRINT , "COMPACTAR BASE DE DATOS"
   PRINT
   PRINT "Compactando..."
   PRINT

   n1 = 1 'Contador para recorrer archivo original
   n2 = 1 'Contador para recorrer archivo nuevo
   WHILE n1 <= numregS
      GET #1, n1, registro

      IF registro.nombre <> SPACE$(LEN(registro.nombre)) OR registro.direccion <> SPACE$(LEN(registro.direccion)) OR registro.telefono <> SPACE$(LEN(registro.telefono)) OR registro.edad <> -1 THEN
         'Si el registro no est  vac¡o lo copiamos al nuevo fichero
         PUT #2, n2, registro
         n2 = n2 + 1  'Y aumentamos su contador
      END IF
      n1 = n1 + 1 'aumentamos el contador del fichero original siempre
   WEND
                                         
   CLOSE 'Cerramos LOS DOS archivos

   KILL "Agenda.dat" 'Borramos el archivo viejo
   NAME "Agenda.tmp" AS "Agenda.dat"'Renombramos el temporal como "Agenda.dat"
  
   AbreArchivo "Agenda.dat" 'Abrimos para seguir normalmente con el programa

   'ahora sacamos un mensaje para terminar
   PRINT
   PRINT "La base de datos ha sido compactada"
   SLEEP
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'           
SUB Listado
   DIM persona AS tipopersona
 
   numregS = (LOF(1) / LEN(persona)) 'Calculamos cuantos registros hay
 
   linea = 0
   n = 1

   CLS
   PRINT , "LISTADO DE PERSONAS"
   PRINT
   PRINT "Pulsa una tecla..."

   WHILE n <= numregS
      IF linea = 0 THEN 'La primera vez entramos, y cuando linea vuelva a valer 0
         WHILE INKEY$ <> "": WEND'Para que no se acumulen las teclas pulsadas
         SLEEP 'Pulsa una tecla
         CLS
         PRINT " Reg  Nombre                Direcci¢n                       Tel‚fono    Edad"
         PRINT " ==== ===================== =============================== =========== ===="
         linea = 20 'N£mero m ximo de l¡neas de datos que caben en la pantalla
      END IF
      GET #1, n, persona
      IF persona.nombre <> SPACE$(LEN(persona.nombre)) OR persona.direccion <> SPACE$(LEN(persona.direccion)) OR persona.telefono <> SPACE$(LEN(persona.telefono)) OR persona.edad <> -1 THEN
         linea = linea - 1 'Vamos descendiendo, cuando llegue a 0 pintamos encabezado
         PRINT n; "   "; persona.nombre; "  "; persona.direccion; "  "; persona.telefono; "  "; persona.edad
         'Los especios entre datos los ponemos para que no salga todo seguido
      END IF
      n = n + 1 'aumentamos registro siempre
   WEND
   SLEEP'Pulsa tecla antes de salir
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'           
SUB Modifica
 
   DIM persona AS tipopersona
 
   numregS = (LOF(1) / LEN(persona)) 'Calculamos cuantos registros hay
 
   CLS
   PRINT , "MODIFICAR PERSONA"
   PRINT
 
   IF numregS = 0 THEN
      PRINT "Base de datos vac¡a"
   ELSE

      INPUT "N£mero de registro a modificar: ", nummodif%
      PRINT
    
      IF nummodif% < 1 OR nummodif% > numregS THEN

         PRINT "N£mero de registro incorrecto"

      ELSE

         GET #1, nummodif%, persona
       
         PRINT "Nombre.....: "; persona.nombre
         PRINT "Direcci¢n..: "; persona.direccion
         PRINT "Tel‚fono...: "; persona.telefono
         PRINT "Edad.......:"; persona.edad
         PRINT
         PRINT "¨Es este el registro que quieres modificar? (S/N)"
         PRINT
       
         WHILE INKEY$ <> "": WEND 'Para limpiar INKEY$
       
         DO
            tecla$ = UCASE$(INKEY$)               'Transforma a may£sculas
         LOOP UNTIL tecla$ = "S" OR tecla$ = "N"  'Espera hasta que pulsemos S ¢ N
       
         IF tecla$ = "S" THEN
            PRINT "Escribe los nuevos datos..."
            PRINT
            INPUT "Nombre: ", persona.nombre
            INPUT "Direcci¢n: ", persona.direccion
            INPUT "Tel‚fono: ", persona.telefono
            INPUT "Edad: ", persona.edad
            'Graba en el fichero
            PUT #1, nummodif%, persona
            PRINT "Los nuevos datos han sustituido a los anteriores"
         ELSE
            PRINT "No se ha modificado nada"
         END IF
      END IF
   END IF
 
   SLEEP 'Esperamos a que pulse una tecla

END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'           
SUB Nuevo
   DIM persona AS tipopersona
   numReg = (LOF(1) / LEN(persona)) + 1'Calculamos posici¢n nuevo registro
   CLS
   PRINT , "A¥ADIR NUEVA PERSONA"
   PRINT
   PRINT "Registro"; numReg
   PRINT
   INPUT "Nombre: ", persona.nombre
   INPUT "Direcci¢n: ", persona.direccion
   INPUT "Tel‚fono: ", persona.telefono
   INPUT "Edad: ", persona.edad
   PUT #1, numReg, persona
END SUB

'
'  © JM. :: Hecho en Ronda
'
'
'  Procedente de...    www.jm-web.tk     ::    es.geocities.com/jm00092
'
'______________________________________________________________________
'           
'Dibuja en la pantalla el t¡tulo del programa y las opciones del men£
'
SUB PintaMenu

CLS
PRINT
PRINT , , "* * * * * * * * * * * *"
PRINT , , "* AGENDA SUPER BARATA *"
PRINT , , "*                     *"
PRINT , , "* J.M.G.B. Ronda 1998 *"
PRINT , , "* * * * * * * * * * * *"
PRINT
PRINT
PRINT , "A ... A¤adir nueva persona"
PRINT , "B ... Borrar persona"
PRINT , "M ... Modificar persona"
PRINT
PRINT , "N ... Buscar persona por nombre"
PRINT , "D ... Buscar persona por direcci¢n"
PRINT , "T ... Buscar persona por tel‚fono"
PRINT , "E ... Buscar persona por edad"
PRINT
PRINT , "L ... Ver listado de personas"
PRINT
PRINT , "C ... Compactar base de datos"
PRINT
PRINT , "S ... Salir"


END SUB