Como buscar por nombre en un registro indexado?

[Marengo97]

Quiero implementar la funcion de buscar por nombre en un archivo indexado, no tengo claro como hacerlo

Codigo completo:
IDENTIFICATION DIVISION.

PROGRAM-ID. LIBRERIA.
AUTHOR. LUCAS GALEANO.
DATE-WRITTEN 9/7/2023.

ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT REG-LIBROS ASSIGN TO "REGISTRO-LIBROS.DAT"
ORGANIZATION IS INDEXED
RECORD KEY IS LIBRO-ID
ALTERNATE RECORD KEY IS NOMBRE
ALTERNATE RECORD KEY IS EDITORIAL
ACCESS MODE IS DYNAMIC
FILE STATUS FS-REGISTRO-LIBROS.


DATA DIVISION.
FILE SECTION.

FD REG-LIBROS.

01 DATOS-LIBRO.
05 LIBRO-ID PIC 999 VALUE ZEROS.
05 NOMBRE PIC X(20) VALUE SPACES.
05 EDITORIAL PIC X(20) VALUE SPACES.
05 ESTADO PIC X(12) VALUE SPACES.
*05 FECHA-INGRESO.
* 10 DIA PIC 99 VALUE ZEROS.
* 10 MES PIC X(10) VALUE SPACES.
* 10 AÑO PIC 9999 VALUE ZEROS.
* 05 FECHA-ALQUILER.
* 10 DDIA PIC 99 VALUE ZEROS.
* 10 MMES PIC X(10) VALUE SPACES.
* 10 AAÑO PIC 9999 VALUE ZEROS.

WORKING-STORAGE SECTION.
*Codigos de error del archivo.
01 FS-REGISTRO-LIBROS PIC XX.
88 ESTA-REG VALUE "00" "02".
88 N-ESTA-REG VALUE "23".
88 F-NOEXISTE-REG VALUE "35".
88 FIN-REG VALUE "10".
88 F-ABIERTO VALUE "12".
*Variables del programa.
77 CONTINUAR PIC X.
77 CONTINUAR-REG PIC X.
77 ELIMINAR-OPC PIC X.
77 BUSCAR-OPC PIC X.
77 OPC PIC X.
77 LIMPIAR PIC X(80) VALUE SPACES.
77 LIMPIAR-LINEA PIC X(80) VALUE SPACES.
77 N PIC 99.
77 AUX-ID PIC 999.
77 AUX-NOMBRE PIC X(20).

PROCEDURE DIVISION.
DECLARATIVES.
*Estados de error del archivo
FILE-ERROR SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON REG-LIBROS.
IF FS-REGISTRO-LIBROS EQUALS "35" THEN
SET F-NOEXISTE-REG TO TRUE
END-IF.
END DECLARATIVES.
*LOGICA PRINCIPAL
MENU.
PERFORM UNTIL CONTINUAR = "N"
PERFORM LIMPIAR-PANTALLA
DISPLAY "ADMINISTRADOR DE CATALOGO" AT LINE 1 COL 1 WITH
REVERSE-VIDEO
DISPLAY " " AT LINE 3 COL 1
DISPLAY "1.Registrar, Editar, Remplazar libro" AT LINE 4
COL 1
DISPLAY "2.Eliminar libro" AT LINE 5 COL 1
DISPLAY "3.Ver catalogo" AT LINE 6 COL 1
DISPLAY "4.Crear nuevo registro" AT LINE 7 COL 1
DISPLAY "5.Buscar libro" AT LINE 8
DISPLAY "0.Salir" AT LINE 9 COL 1
DISPLAY " " AT LINE 10 COL 1
DISPLAY "Ingrese tecla ( )" AT LINE 11 COL 1 WITH
REVERSE-VIDEO
ACCEPT OPC AT LINE 11 COL 16 WITH
PROMPT UNDERLINE
EVALUATE OPC
WHEN 1 PERFORM REGISTRAR-LIBRO
WHEN 2 PERFORM ELIMINAR-LIBRO
WHEN 3 PERFORM VER-LIBROS
WHEN 4 PERFORM CREAR-ARCHIVO
WHEN 5 PERFORM BUSCAR-LIBRO
WHEN 0 MOVE "N" TO CONTINUAR
END-EVALUATE
END-PERFORM.
CLOSE REG-LIBROS.
STOP RUN.


REGISTRAR-LIBRO.
MOVE SPACES TO DATOS-LIBRO.
PERFORM LIMPIAR-PANTALLA.
MOVE "S" TO CONTINUAR-REG.
************************************************** ***********************
*INTERFAZ MENU DE INGRESO DE DATOS
************************************************** ***********************
DISPLAY "Numero de serie:" AT LINE 1 COL 1.
DISPLAY "Nombre:" AT LINE 2 COL 1.
DISPLAY "Editorial:" AT LINE 3 COL 1.
DISPLAY "Estado:" AT LINE 4 COL 1.
DISPLAY
"presione ENTER sin ingresar datos para salir al menu"
AT LINE 7 COL 12
WITH REVERSE-VIDEO.


DISPLAY "Numero de serie :" AT LINE 1 COL 1 WITH
REVERSE-VIDEO.
ACCEPT LIBRO-ID WITH PROMPT UNDERLINE UPDATE AT LINE 1
COL 25.

IF LIBRO-ID EQUALS 000 MOVE "N" TO CONTINUAR-REG END-IF.


IF CONTINUAR-REG EQUALS "S"
DISPLAY "Numero de serie :" AT LINE 1 COL 1
DISPLAY LIBRO-ID AT LINE 1 COL 25

DISPLAY "Nombre :" AT LINE 2 COL 1 WITH REVERSE-VIDEO
ACCEPT NOMBRE AT LINE 2 COL 25
DISPLAY "Nombre: " AT LINE 2 COL 1
DISPLAY NOMBRE AT LINE 2 COL 25

DISPLAY "Editorial :" AT LINE 3 COL 1 WITH REVERSE-VIDEO
ACCEPT EDITORIAL AT LINE 3 COL 25
DISPLAY "Editorial :" AT LINE 3 COL 1
DISPLAY EDITORIAL AT LINE 3 COL 25

DISPLAY "Estado :" AT LINE 4 COL 1 WITH REVERSE-VIDEO
ACCEPT ESTADO AT LINE 4 COL 25
DISPLAY "Estado :" AT LINE 4 COL 1
DISPLAY ESTADO AT LINE 4 COL 25
************************************************** ***********************
PERFORM ABRIR-IO-ARCHIVO
WRITE DATOS-LIBRO INVALID KEY
REWRITE DATOS-LIBRO INVALID KEY
PERFORM LIMPIAR-PANTALLA
DISPLAY "ERROR AL REGISTRAR DATOS" AT LINE 1 COL 1
WITH BACKGROUND-COLOR 4
END-WRITE
PERFORM CERRAR-ARCHIVO
END-IF.


VER-LIBROS.
PERFORM ABRIR-ARCHIVO-INPUT.
IF F-NOEXISTE-REG THEN
PERFORM LIMPIAR-PANTALLA
DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS"
WITH BACKGROUND-COLOR 4 AT LINE 1 COL 1



DISPLAY "Presione ENTER para salir al menu"
AT LINE 7 COL 12 WITH
REVERSE-VIDEO
ACCEPT OPC AT LINE 10 COL 34
ELSE
PERFORM LIMPIAR-PANTALLA
INITIALIZE LIBRO-ID
START REG-LIBROS KEY IS >= LIBRO-ID END-START
READ REG-LIBROS NEXT RECORD END-READ
DISPLAY
"ID |TITULO |EDITORIAL |ESTADO "
WITH REVERSE-VIDEO AT LINE 1 COL 1
PERFORM VARYING N FROM 02 BY 1 UNTIL FIN-REG
DISPLAY DATOS-LIBRO AT LINE N COL 1
READ REG-LIBROS NEXT RECORD END-READ
END-PERFORM
ADD 1 TO N
DISPLAY "Presione ENTER para salir al menu"
AT LINE N COL 1 WITH
REVERSE-VIDEO
ACCEPT OPC AT LINE N COL 34
PERFORM CERRAR-ARCHIVO
END-IF.


ELIMINAR-LIBRO.
PERFORM ABRIR-IO-ARCHIVO.
PERFORM LIMPIAR-PANTALLA.
MOVE SPACES TO DATOS-LIBRO

DISPLAY "Indique por id el libro que desea eliminar:"
WITH REVERSE-VIDEO AT LINE 1 COL 1.
DISPLAY "Presione ENTER para salir al menu"
WITH REVERSE-VIDEO AT LINE 7 COL 12.

ACCEPT LIBRO-ID AT LINE 1 COL 46 WITH PROMPT UNDERLINE UPDATE.

IF LIBRO-ID NOT EQUALS 000

PERFORM LIMPIAR-PANTALLA

START REG-LIBROS KEY IS = LIBRO-ID
READ REG-LIBROS END-READ
IF ESTA-REG
DISPLAY
"ID |TITULO |EDITORIAL |ESTADO "
WITH REVERSE-VIDEO AT LINE 1 COL 1
DISPLAY DATOS-LIBRO AT LINE 2 COL 1
DISPLAY "ELIMINAR(1)|VOLVER(0) :" AT LINE 5 COL 1
WITH REVERSE-VIDEO

ACCEPT ELIMINAR-OPC AT LINE 5 COL 25
EVALUATE ELIMINAR-OPC
WHEN 1
DISPLAY LIMPIAR-LINEA AT LINE 10 COL 1
DELETE REG-LIBROS INVALID KEY
DISPLAY "ERROR AL ELIMINAR" AT LINE 5 COL 1
END-DELETE
DISPLAY "REGISTRO ELIMINADO CON EXITO" AT LINE 5
COL 1
WITH BACKGROUND-COLOR 2
ACCEPT OPC AT LINE 5 COL 29
WHEN 0 PERFORM ELIMINAR-LIBRO
ELSE
DISPLAY "EL REGISTRO NO EXISTE" AT LINE 1 COL 1
WITH BACKGROUND-COLOR 4
ACCEPT OPC AT LINE 1 COL 22
END-IF

END-IF.
PERFORM CERRAR-ARCHIVO.


CREAR-ARCHIVO.
PERFORM ABRIR-IO-ARCHIVO
IF NOT F-NOEXISTE-REG THEN
PERFORM LIMPIAR-PANTALLA
DISPLAY "SE DETECTO UN ARCHIVO EXISTENTE, DE PROCEDER EL"
AT LINE 1 COL 1 WITH BACKGROUND-COLOR 6
" ARCHIVO ACTUAL SERA ELIMINADO" AT LINE 1 COL 48
WITH BACKGROUND-COLOR 6
DISPLAY "ELIMINAR(1)|SALIR AL MENU(0) :" AT LINE 10 COL 1
WITH REVERSE-VIDEO
ACCEPT ELIMINAR-OPC AT LINE 10 COL 31
EVALUATE ELIMINAR-OPC
WHEN 1
PERFORM CERRAR-ARCHIVO
OPEN OUTPUT REG-LIBROS
PERFORM CERRAR-ARCHIVO
PERFORM LIMPIAR-PANTALLA
DISPLAY "ARCHIVO CREADO CON EXITO."
WITH BACKGROUND-COLOR 2
ACCEPT OPC AT LINE 1 COL 27
WHEN 0 PERFORM CERRAR-ARCHIVO EXIT
ELSE
OPEN OUTPUT REG-LIBROS
CLOSE REG-LIBROS
PERFORM LIMPIAR-PANTALLA
DISPLAY "ARCHIVO CREADO CON EXITO."
WITH BACKGROUND-COLOR 2
ACCEPT OPC AT LINE 1 COL 27
END-IF.

BUSCAR-LIBRO.
PERFORM LIMPIAR-PANTALLA.
PERFORM ABRIR-ARCHIVO-INPUT.
MOVE SPACES TO DATOS-LIBRO.

IF ESTA-REG
DISPLAY "MENU DE BUSQUEDA" AT LINE 1 COL 1
WITH REVERSE-VIDEO
DISPLAY "(I)Busqueda por id" AT LINE 3 COL 1
DISPLAY "(N)Busqueda por nombre" AT LINE 4 COL 1
DISPLAY "(E)Busqueda por editorial" AT LINE 5 COL 1
DISPLAY "Ingrese opcion( )" AT LINE 7 COL 1
WITH REVERSE-VIDEO
ACCEPT BUSCAR-OPC AT LINE 7 COL 16
IF BUSCAR-OPC EQUALS "i" MOVE "I" TO BUSCAR-OPC END-IF
IF BUSCAR-OPC EQUALS "n" MOVE "N" TO BUSCAR-OPC END-IF
IF BUSCAR-OPC EQUALS "e" MOVE "E" TO BUSCAR-OPC END-IF

EVALUATE BUSCAR-OPC
WHEN "I"

WHEN "N"

WHEN "E"
PERFORM BUSCAR-NOMBRE
END-EVALUATE





ELSE
DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS"
AT LINE 1 COL 1 WITH BACKGROUND-COLOR 4
ACCEPT OPC AT LINE 1 COL 43
END-IF.
************************************************** ***********************
*BLOQUE DE CODIGO DE BUSQUEDAS
************************************************** ***********************
BUSCAR-NOMBRE.
PERFORM LIMPIAR-PANTALLA.
PERFORM ABRIR-ARCHIVO-INPUT.
MOVE SPACES TO DATOS-LIBRO.
DISPLAY "Titulo: " AT LINE 2 COL 1 WITH REVERSE-VIDEO
DISPLAY "---------------------------------------------------"
AT LINE 3 COL 1.

DISPLAY
"ID |TITULO |EDITORIAL |ESTADO "
WITH REVERSE-VIDEO AT LINE 3 COL 1.
ACCEPT NOMBRE AT LINE 2 COL 14.


START REG-LIBROS KEY IS = NOMBRE.
READ REG-LIBROS END-READ
DISPLAY DATOS-LIBRO AT LINE 4 COL 1
ACCEPT OPC AT LINE 5 COL 1.


************************************************** ***********************
LIMPIAR-PANTALLA.
PERFORM VARYING N FROM 01 BY 1 UNTIL N>24
DISPLAY LIMPIAR AT LINE N COLUMN 1
END-PERFORM.

ABRIR-ARCHIVO-INPUT.
OPEN INPUT REG-LIBROS.

ABRIR-IO-ARCHIVO.
OPEN I-O REG-LIBROS.

CERRAR-ARCHIVO.
CLOSE REG-LIBROS.


BLOQUE DE CODIGO ESPECIFICO:

BUSCAR-NOMBRE.
PERFORM LIMPIAR-PANTALLA.
PERFORM ABRIR-ARCHIVO-INPUT.
MOVE SPACES TO DATOS-LIBRO.
DISPLAY "Titulo: " AT LINE 2 COL 1 WITH REVERSE-VIDEO
DISPLAY "---------------------------------------------------"
AT LINE 3 COL 1.

DISPLAY
"ID |TITULO |EDITORIAL |ESTADO "
WITH REVERSE-VIDEO AT LINE 3 COL 1.
ACCEPT NOMBRE AT LINE 2 COL 14.


START REG-LIBROS KEY IS = NOMBRE.
READ REG-LIBROS END-READ
DISPLAY DATOS-LIBRO AT LINE 4 COL 1
ACCEPT OPC AT LINE 5 COL 1.

Utilizé la misma logica para buscar por una key numerica, que funciona perfecto pero no con la secondary key NOMBRE

[JCantero]

@Marengo97, más o menos te lo dije en otro post.


Metidos en el tema, suponte que deseas seleccionar un intevalo de libros:

accept nombre-desde
accept nombre-hasta


VER-LIBROS.
PERFORM LIMPIAR-PANTALLA
PERFORM ABRIR-Input-ARCHIVO
IF F-NOEXISTE-REG THEN
PERFORM LIMPIAR-PANTALLA
DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS" AT LINE 1
COL 1

DISPLAY "PRESIONE ENTER PARA VOLVER AL MENU()" AT LINE 10
COL 1
ACCEPT OPC AT LINE 11 COL 36
ELSE
PERFORM LIMPIAR-PANTALLA

move nombre-desde to nombre
if nombre-hasta = " " then move hight-values to nombre-hasta end-if

start reg-libros key is >= nombre end-start
READ REG-LIBROS next record end-read

PERFORM VARYING N FROM 1 BY 1 UNTIL fin-reg or nombre > nombre-hasta
DISPLAY DATOS-LIBRO AT LINE N COL 1
READ REG-LIBROS next record end-read
END-PERFORM
ADD 1 TO N
DISPLAY "PRESIONE ENTER PARA REGRESAR AL MENU" AT LINE N
COL 1
ACCEPT OPC AT LINE 15
PERFORM CERRAR-ARCHIVO
END-IF.



Se pueden hacer cosas interesantes como buscar mayúsculas y minúsculas, e incluso que contengan una cadena, "luna", "árbol".

- - - Updated - - -

Otra cosa.


SELECT REG-LIBROS ASSIGN TO "REGISTRO-LIBROS.DAT"
ORGANIZATION IS INDEXED
RECORD KEY IS LIBRO-ID
ALTERNATE RECORD KEY IS NOMBRE with duplicates
ALTERNATE RECORD KEY IS EDITORIAL With duplicates
ACCESS MODE IS DYNAMIC
FILE STATUS FS-REGISTRO-LIBROS.




Ya que la editorial se puede repetir

[Marengo97]

No logro que funcione, no entiendo bien como funciona, debo de hacer un desde-nombre, hasta-nombre para recorrer ? Algo estoy pasando de alto, le dejo el bloque de codigo aunque lo modifique muchas veces sin exito
BUSCAR-NOMBRE.
PERFORM LIMPIAR-PANTALLA.
PERFORM ABRIR-ARCHIVO-INPUT.
MOVE SPACES TO DATOS-LIBRO.
DISPLAY "Titulo: " AT LINE 2 COL 1 WITH REVERSE-VIDEO
DISPLAY "---------------------------------------------------"
AT LINE 3 COL 1.

DISPLAY
"ID |TITULO |EDITORIAL |ESTADO "
WITH REVERSE-VIDEO AT LINE 3 COL 1.
ACCEPT AUX-NOMBRE AT LINE 2 COL 14.
MOVE AUX-NOMBRE TO HASTA-NOMBRE
DISPLAY NOMBRE
START REG-LIBROS KEY IS >= NOMBRE
READ REG-LIBROS NEXT RECORD END-READ
PERFORM VARYING N FROM 01 BY 1 UNTIL FIN-REG
OR NOMBRE > HASTA-NOMBRE
READ REG-LIBROS NEXT RECORD END-READ
DISPLAY DATOS-LIBRO AT LINE N COL 1
END-PERFORM
ACCEPT OPC AT LINE 5 COL 1.

[JCantero]

@Marengo97, puedes hacer una consulta desde hasta o bien puedes hacer una consulta que contenga una palabra o un string.

Eso ya depende de de lo que tú quieras hacer

- - - Updated - - -

Yo para ciertas consultas o listados pido un intervalo desde hasta.

Para otro tipo de consulta pido que contenga una palabra o un conjunto de palabras.

Claro está , cada cosa hay que implementarla

[Marengo97]

Seria mucha molestia si lo hiciera por mi para poder verlo? Se me acabaron las opciones, no lo puedo hacer funcionar, me muestra todo en espacios o todo en espacios vacios excepto en el area de NOMBRE, hagalo a su gusto quiero ver como debe de hacerse correctamente. Gracias de todas formas.

[JCantero]

@Marengo97, la opción del post 2 debe funcionar con nombre desde nombre hasta.

Ponlo en tu código y si no te funciona ponlo aquí para que lo veamos y poder solucionarlo

[Marengo97]

Asi lo tengo ahora:
BUSCAR-NOMBRE.
PERFORM LIMPIAR-PANTALLA.
PERFORM ABRIR-ARCHIVO-INPUT.
MOVE SPACES TO DATOS-LIBRO
DISPLAY "Titulo: " AT LINE 2 COL 1 WITH REVERSE-VIDEO
DISPLAY "---------------------------------------------------"
AT LINE 3 COL 1.

DISPLAY
"ID |TITULO |EDITORIAL |ESTADO "
WITH REVERSE-VIDEO AT LINE 3 COL 1.
ACCEPT DESDE-NOMBRE AT LINE 2 COL 14.
MOVE DESDE-NOMBRE TO NOMBRE.
MOVE NOMBRE TO HASTA-NOMBRE.
START REG-LIBROS KEY IS >= NOMBRE END-START.
READ REG-LIBROS NEXT RECORD END-READ.
PERFORM VARYING N FROM 01 BY 1 UNTIL FIN-REG OR
NOMBRE > HASTA-NOMBRE
DISPLAY DATOS-LIBRO AT LINE 4 COL 1

READ REG-LIBROS NEXT RECORD END-READ
END-PERFORM.

ACCEPT OPC AT LINE 10 COL 1.
PERFORM CERRAR-ARCHIVO.

Te adjunto 3 capturas de pantallas:
Estas dos primeras son con "READ REG-LIBROS END-READ" en la linea 16
918
919
Muestra registros erroneos o simplemente espacios vacios, creo que los campos estan en sus valores por default.
Esta tercera es con "READ REG-LIBROS NEXT RECORD END-READ" tambien en la linea 16917
Aca, me muestra todo espacios vacios no importa cual registro sea.

[JCantero]

@Marengo97, he probado el código y funciona perfectamente.

Si te saca campos en blanco es porque no metiste nada.

Lo que hace este bucle es:

- pedir nombre
- hacer un start por ese nombre
- leer el primero y sacar siguientes que sean iguales a ese nombre.

Prueba a inicializar el fichero y meter todos los campos bien.

[JCantero]

@Marengo97, mira esto.

Te he cambiado el parrafo de registrar libro porque no funcionaba en el caso de que exista un libro.

Cuando se teclee un libro, hay que leerlo para sacar la informacion. De lo contrario si bajas con intro se reescribe el libro pero con datos en blanco.

al final he añadido una cosa mas elegante, hacias un write y si da error un rewrite. Para mi es mejor si existia rewrite y si no write.



IDENTIFICATION DIVISION.

PROGRAM-ID. LIBRERIA.
AUTHOR. LUCAS GALEANO.
DATE-WRITTEN 9/7/2023.

ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT REG-LIBROS ASSIGN TO "REGISTRO-LIBROS.DAT"
ORGANIZATION IS INDEXED
RECORD KEY IS LIBRO-ID
ALTERNATE RECORD KEY IS NOMBRE
ALTERNATE RECORD KEY IS EDITORIAL
ACCESS MODE IS DYNAMIC
FILE STATUS FS-REGISTRO-LIBROS.


DATA DIVISION.
FILE SECTION.

FD REG-LIBROS.

01 DATOS-LIBRO.
05 LIBRO-ID PIC 999 VALUE ZEROS.
05 NOMBRE PIC X(20) VALUE SPACES.
05 EDITORIAL PIC X(20) VALUE SPACES.
05 ESTADO PIC X(12) VALUE SPACES.
*05 FECHA-INGRESO.
* 10 DIA PIC 99 VALUE ZEROS.
* 10 MES PIC X(10) VALUE SPACES.
* 10 AÑO PIC 9999 VALUE ZEROS.
* 05 FECHA-ALQUILER.
* 10 DDIA PIC 99 VALUE ZEROS.
* 10 MMES PIC X(10) VALUE SPACES.
* 10 AAÑO PIC 9999 VALUE ZEROS.

WORKING-STORAGE SECTION.
*Codigos de error del archivo.
01 FS-REGISTRO-LIBROS PIC XX.
88 ESTA-REG VALUE "00" "02".
88 N-ESTA-REG VALUE "23".
88 F-NOEXISTE-REG VALUE "35".
88 FIN-REG VALUE "10".
88 F-ABIERTO VALUE "12".
*Variables del programa.
77 CONTINUAR PIC X.
77 CONTINUAR-REG PIC X.
77 ELIMINAR-OPC PIC X.
77 BUSCAR-OPC PIC X.
77 OPC PIC X.
77 LIMPIAR PIC X(80) VALUE SPACES.
77 LIMPIAR-LINEA PIC X(80) VALUE SPACES.
77 N PIC 99.
77 AUX-ID PIC 999.
77 AUX-NOMBRE PIC X(20).
01 DESDE-NOMBRE PIC X(20).
01 HASTA-NOMBRE PIC X(20).

PROCEDURE DIVISION.
DECLARATIVES.
*Estados de error del archivo
FILE-ERROR SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON REG-LIBROS.
IF FS-REGISTRO-LIBROS EQUALS "35" THEN
SET F-NOEXISTE-REG TO TRUE
END-IF.
END DECLARATIVES.
*LOGICA PRINCIPAL
MENU.
PERFORM UNTIL CONTINUAR = "N"
PERFORM LIMPIAR-PANTALLA
DISPLAY "ADMINISTRADOR DE CATALOGO" AT LINE 1 COL 1 WITH
REVERSE-VIDEO
DISPLAY " " AT LINE 3 COL 1
DISPLAY "1.Registrar, Editar, Remplazar libro" AT LINE 4
COL 1
DISPLAY "2.Eliminar libro" AT LINE 5 COL 1
DISPLAY "3.Ver catalogo" AT LINE 6 COL 1
DISPLAY "4.Crear nuevo registro" AT LINE 7 COL 1
DISPLAY "5.Buscar libro" AT LINE 8
DISPLAY "0.Salir" AT LINE 9 COL 1
DISPLAY " " AT LINE 10 COL 1
DISPLAY "Ingrese tecla ( )" AT LINE 11 COL 1 WITH
REVERSE-VIDEO
ACCEPT OPC AT LINE 11 COL 16 WITH
PROMPT UNDERLINE
EVALUATE OPC
WHEN 1 PERFORM REGISTRAR-LIBRO
WHEN 2 PERFORM ELIMINAR-LIBRO
WHEN 3 PERFORM VER-LIBROS
WHEN 4 PERFORM CREAR-ARCHIVO
WHEN 5 PERFORM BUSCAR-LIBRO
WHEN 0 MOVE "N" TO CONTINUAR
END-EVALUATE
END-PERFORM.
CLOSE REG-LIBROS.
STOP RUN.


REGISTRAR-LIBRO.
MOVE SPACES TO DATOS-LIBRO.
PERFORM LIMPIAR-PANTALLA.
MOVE "S" TO CONTINUAR-REG.
************************************************** ***********************
*INTERFAZ MENU DE INGRESO DE DATOS
************************************************** ***********************
DISPLAY "Numero de serie:" AT LINE 1 COL 1.
DISPLAY "Nombre:" AT LINE 2 COL 1.
DISPLAY "Editorial:" AT LINE 3 COL 1.
DISPLAY "Estado:" AT LINE 4 COL 1.
DISPLAY
"presione ENTER sin ingresar datos para salir al menu"
AT LINE 7 COL 12
WITH REVERSE-VIDEO.


DISPLAY "Numero de serie :" AT LINE 1 COL 1 WITH
REVERSE-VIDEO.
initialize DATOS-LIBRO
ACCEPT LIBRO-ID WITH PROMPT UNDERLINE UPDATE AT LINE 1
COL 25.

IF LIBRO-ID EQUALS 000 MOVE "N" TO CONTINUAR-REG END-IF.


IF CONTINUAR-REG EQUALS "S"
PERFORM ABRIR-IO-ARCHIVO
read REG-LIBROS end-read
if ESTA-REG THEN
DISPLAY NOMBRE AT LINE 2 COL 25
DISPLAY EDITORIAL AT LINE 3 COL 25
DISPLAY ESTADO AT LINE 4 COL 25
end-if
DISPLAY "Numero de serie :" AT LINE 1 COL 1
DISPLAY LIBRO-ID AT LINE 1 COL 25

DISPLAY "Nombre :" AT LINE 2 COL 1
WITH REVERSE-VIDEO
ACCEPT NOMBRE AT LINE 2 COL 25
DISPLAY "Nombre: " AT LINE 2 COL 1
DISPLAY NOMBRE AT LINE 2 COL 25

DISPLAY "Editorial :" AT LINE 3 COL 1
WITH REVERSE-VIDEO
ACCEPT EDITORIAL AT LINE 3 COL 25
DISPLAY "Editorial :" AT LINE 3 COL 1
DISPLAY EDITORIAL AT LINE 3 COL 25

DISPLAY "Estado :" AT LINE 4 COL 1
WITH REVERSE-VIDEO
ACCEPT ESTADO AT LINE 4 COL 25
DISPLAY "Estado :" AT LINE 4 COL 1
DISPLAY ESTADO AT LINE 4 COL 25
************************************************** ***********************

if N-ESTA-REG then
WRITE DATOS-LIBRO end-write
else
REWRITE DATOS-LIBRO END-REWRITE
end-if
if not ESTA-REG then
PERFORM LIMPIAR-PANTALLA
DISPLAY "ERROR AL REGISTRAR DATOS" AT LINE 1 COL 1
WITH BACKGROUND-COLOR 4
end-if
PERFORM CERRAR-ARCHIVO
END-IF.


VER-LIBROS.
PERFORM ABRIR-ARCHIVO-INPUT.
IF F-NOEXISTE-REG THEN
PERFORM LIMPIAR-PANTALLA
DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS"
WITH BACKGROUND-COLOR 4 AT LINE 1 COL 1



DISPLAY "Presione ENTER para salir al menu"
AT LINE 7 COL 12 WITH
REVERSE-VIDEO
ACCEPT OPC AT LINE 10 COL 34
ELSE
PERFORM LIMPIAR-PANTALLA
INITIALIZE LIBRO-ID
START REG-LIBROS KEY IS >= LIBRO-ID END-START
READ REG-LIBROS NEXT RECORD END-READ
DISPLAY
"ID |TITULO |EDITORIAL |ESTADO "
WITH REVERSE-VIDEO AT LINE 1 COL 1
PERFORM VARYING N FROM 02 BY 1 UNTIL FIN-REG
DISPLAY DATOS-LIBRO AT LINE N COL 1
READ REG-LIBROS NEXT RECORD END-READ
END-PERFORM
ADD 1 TO N
DISPLAY "Presione ENTER para salir al menu"
AT LINE N COL 1 WITH
REVERSE-VIDEO
ACCEPT OPC AT LINE N COL 34
PERFORM CERRAR-ARCHIVO
END-IF.


ELIMINAR-LIBRO.
PERFORM ABRIR-IO-ARCHIVO.
PERFORM LIMPIAR-PANTALLA.
MOVE SPACES TO DATOS-LIBRO

DISPLAY "Indique por id el libro que desea eliminar:"
WITH REVERSE-VIDEO AT LINE 1 COL 1.
DISPLAY "Presione ENTER para salir al menu"
WITH REVERSE-VIDEO AT LINE 7 COL 12.

ACCEPT LIBRO-ID AT LINE 1 COL 46 WITH PROMPT UNDERLINE UPDATE.

IF LIBRO-ID NOT EQUALS 000

PERFORM LIMPIAR-PANTALLA

START REG-LIBROS KEY IS = LIBRO-ID
READ REG-LIBROS END-READ
IF ESTA-REG
DISPLAY
"ID |TITULO |EDITORIAL |ESTADO "
WITH REVERSE-VIDEO AT LINE 1 COL 1
DISPLAY DATOS-LIBRO AT LINE 2 COL 1
DISPLAY "ELIMINAR(1)|VOLVER(0) :" AT LINE 5 COL 1
WITH REVERSE-VIDEO

ACCEPT ELIMINAR-OPC AT LINE 5 COL 25
EVALUATE ELIMINAR-OPC
WHEN 1
DISPLAY LIMPIAR-LINEA AT LINE 10 COL 1
DELETE REG-LIBROS INVALID KEY
DISPLAY "ERROR AL ELIMINAR" AT LINE 5 COL 1
END-DELETE
DISPLAY "REGISTRO ELIMINADO CON EXITO" AT LINE 5
COL 1
WITH BACKGROUND-COLOR 2
ACCEPT OPC AT LINE 5 COL 29
WHEN 0 PERFORM ELIMINAR-LIBRO
ELSE
DISPLAY "EL REGISTRO NO EXISTE" AT LINE 1 COL 1
WITH BACKGROUND-COLOR 4
ACCEPT OPC AT LINE 1 COL 22
END-IF

END-IF.
PERFORM CERRAR-ARCHIVO.


CREAR-ARCHIVO.
PERFORM ABRIR-IO-ARCHIVO
IF NOT F-NOEXISTE-REG THEN
PERFORM LIMPIAR-PANTALLA
DISPLAY "SE DETECTO UN ARCHIVO EXISTENTE, DE PROCEDER EL"
AT LINE 1 COL 1 WITH BACKGROUND-COLOR 6
" ARCHIVO ACTUAL SERA ELIMINADO" AT LINE 1 COL 48
WITH BACKGROUND-COLOR 6
DISPLAY "ELIMINAR(1)|SALIR AL MENU(0) :" AT LINE 10 COL 1
WITH REVERSE-VIDEO
ACCEPT ELIMINAR-OPC AT LINE 10 COL 31
EVALUATE ELIMINAR-OPC
WHEN 1
PERFORM CERRAR-ARCHIVO
OPEN OUTPUT REG-LIBROS
PERFORM CERRAR-ARCHIVO
PERFORM LIMPIAR-PANTALLA
DISPLAY "ARCHIVO CREADO CON EXITO."
WITH BACKGROUND-COLOR 2
ACCEPT OPC AT LINE 1 COL 27
WHEN 0 PERFORM CERRAR-ARCHIVO EXIT
ELSE
OPEN OUTPUT REG-LIBROS
CLOSE REG-LIBROS
PERFORM LIMPIAR-PANTALLA
DISPLAY "ARCHIVO CREADO CON EXITO."
WITH BACKGROUND-COLOR 2
ACCEPT OPC AT LINE 1 COL 27
END-IF.

BUSCAR-LIBRO.
PERFORM LIMPIAR-PANTALLA.
PERFORM ABRIR-ARCHIVO-INPUT.
MOVE SPACES TO DATOS-LIBRO.

IF ESTA-REG
DISPLAY "MENU DE BUSQUEDA" AT LINE 1 COL 1
WITH REVERSE-VIDEO
DISPLAY "(I)Busqueda por id" AT LINE 3 COL 1
DISPLAY "(N)Busqueda por nombre" AT LINE 4 COL 1
DISPLAY "(E)Busqueda por editorial" AT LINE 5 COL 1
DISPLAY "Ingrese opcion( )" AT LINE 7 COL 1
WITH REVERSE-VIDEO
ACCEPT BUSCAR-OPC AT LINE 7 COL 16
IF BUSCAR-OPC EQUALS "i" MOVE "I" TO BUSCAR-OPC END-IF
IF BUSCAR-OPC EQUALS "n" MOVE "N" TO BUSCAR-OPC END-IF
IF BUSCAR-OPC EQUALS "e" MOVE "E" TO BUSCAR-OPC END-IF

EVALUATE BUSCAR-OPC
WHEN "I"

WHEN "N"

WHEN "E"
PERFORM BUSCAR-NOMBRE
END-EVALUATE





ELSE
DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS"
AT LINE 1 COL 1 WITH BACKGROUND-COLOR 4
ACCEPT OPC AT LINE 1 COL 43
END-IF.
************************************************** ***********************
*BLOQUE DE CODIGO DE BUSQUEDAS
************************************************** ***********************
BUSCAR-NOMBRE.
PERFORM LIMPIAR-PANTALLA.
PERFORM ABRIR-ARCHIVO-INPUT.
MOVE SPACES TO DATOS-LIBRO
DISPLAY "Titulo: " AT LINE 2 COL 1 WITH REVERSE-VIDEO
DISPLAY "---------------------------------------------------"
AT LINE 3 COL 1.

DISPLAY
"ID |TITULO |EDITORIAL |ESTADO "
WITH REVERSE-VIDEO AT LINE 3 COL 1.
ACCEPT DESDE-NOMBRE AT LINE 2 COL 14.
MOVE DESDE-NOMBRE TO NOMBRE.
MOVE NOMBRE TO HASTA-NOMBRE.
START REG-LIBROS KEY IS >= NOMBRE END-START.
READ REG-LIBROS NEXT RECORD END-READ.
PERFORM VARYING N FROM 01 BY 1 UNTIL FIN-REG OR
NOMBRE > HASTA-NOMBRE
DISPLAY DATOS-LIBRO AT LINE 4 COL 1

READ REG-LIBROS NEXT RECORD END-READ
END-PERFORM.

ACCEPT OPC AT LINE 10 COL 1.
PERFORM CERRAR-ARCHIVO.
************************************************** ***********************
LIMPIAR-PANTALLA.
PERFORM VARYING N FROM 01 BY 1 UNTIL N>24
DISPLAY LIMPIAR AT LINE N COLUMN 1
END-PERFORM.

ABRIR-ARCHIVO-INPUT.
OPEN INPUT REG-LIBROS.

ABRIR-IO-ARCHIVO.
OPEN I-O REG-LIBROS.

CERRAR-ARCHIVO.
CLOSE REG-LIBROS.

[Marengo97]

Buenos dias Cantero, o buenas noches que aca esta por amanecer, si recien se me ocurrio la posibilidad de que el problema era el archivo...te explico, yo implemente las claves secundarias con un archivo YA PREVIAMENTE creado cuando solo utilizaba una MAIN KEY, o sea,LIBRO-ID, y jamas se me ocurrio que ese archivo previo entraria en conflicto si lo indexo con claves secundarias que previamente no declare en codigo, es decir los campos estaban pero no las llaves en el FILE CONTROL.....ahora funciona perfecto, no me la puedo creer.

Gracias por la paciencia

[JCantero]

otra cosa.

Si añades "with duplicates" puedes tener libros diferentes con nombre y editoriales repetidas.

Si no, no. Deberias añadirlo.



SELECT REG-LIBROS ASSIGN TO "REGISTRO-LIBROS.DAT"
ORGANIZATION IS INDEXED
RECORD KEY IS LIBRO-ID
ALTERNATE RECORD KEY IS NOMBRE with duplicates
ALTERNATE RECORD KEY IS EDITORIAL with duplicates
ACCESS MODE IS DYNAMIC
FILE STATUS FS-REGISTRO-LIBROS.