Ver Mensaje Individual
  #9
Antiguo 4 de agosto de 2023, 12:00
JCantero
El Foro es mi casa
Activista del Foro: Activista del Foro - Issue reason: Por participación activa Agradecimientos: Por muchos agradecimientos de parte de los Foreros - Issue reason: Por muchos agradecimientos de parte de los Foreros 
Última Actividad 27.09.2026 07:41
Posts Posts: 442
Likes enviados Enviados: 167
Likes recibidos Recibidos: 269

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


Código COBOL:
  1.        IDENTIFICATION DIVISION.
  2.  
  3.        PROGRAM-ID.                 LIBRERIA.
  4.        AUTHOR.                     LUCAS GALEANO.
  5.        DATE-WRITTEN                9/7/2023.
  6.  
  7.        ENVIRONMENT DIVISION.
  8.        INPUT-OUTPUT SECTION.
  9.        FILE-CONTROL.
  10.            SELECT REG-LIBROS ASSIGN TO "REGISTRO-LIBROS.DAT"
  11.                                ORGANIZATION IS INDEXED
  12.                                RECORD KEY IS LIBRO-ID
  13.                                ALTERNATE RECORD KEY IS NOMBRE
  14.                                ALTERNATE RECORD KEY IS EDITORIAL
  15.                                ACCESS MODE IS DYNAMIC
  16.                                FILE STATUS FS-REGISTRO-LIBROS.
  17.  
  18.  
  19.        DATA DIVISION.
  20.        FILE SECTION.
  21.  
  22.        FD REG-LIBROS.
  23.  
  24.        01 DATOS-LIBRO.
  25.            05 LIBRO-ID PIC 999     VALUE ZEROS.
  26.            05 NOMBRE   PIC X(20)   VALUE SPACES.
  27.            05 EDITORIAL PIC X(20)  VALUE SPACES.
  28.            05 ESTADO   PIC X(12)   VALUE SPACES.
  29.      *05 FECHA-INGRESO.
  30.      *     10 DIA  PIC 99 VALUE ZEROS.
  31.      *     10 MES  PIC X(10) VALUE SPACES.
  32.      *     10 AÑO  PIC 9999 VALUE ZEROS.
  33.      * 05 FECHA-ALQUILER.
  34.      *     10 DDIA PIC 99 VALUE ZEROS.
  35.      *     10 MMES PIC X(10) VALUE SPACES.
  36.      *     10 AAÑO PIC 9999 VALUE ZEROS.
  37.  
  38.        WORKING-STORAGE SECTION.
  39.      *Codigos de error del archivo.
  40.        01 FS-REGISTRO-LIBROS PIC XX.
  41.            88 ESTA-REG         VALUE "00" "02".
  42.            88 N-ESTA-REG       VALUE "23".
  43.            88 F-NOEXISTE-REG   VALUE "35".
  44.            88 FIN-REG          VALUE "10".
  45.            88 F-ABIERTO        VALUE "12".
  46.      *Variables del programa.
  47.        77 CONTINUAR PIC X.
  48.        77 CONTINUAR-REG PIC X.
  49.        77 ELIMINAR-OPC  PIC X.
  50.        77 BUSCAR-OPC    PIC X.    
  51.        77 OPC       PIC X.
  52.        77 LIMPIAR   PIC X(80) VALUE SPACES.
  53.        77 LIMPIAR-LINEA PIC X(80) VALUE SPACES.
  54.        77 N         PIC 99.
  55.        77 AUX-ID    PIC 999.
  56.        77 AUX-NOMBRE PIC X(20).
  57.        01 DESDE-NOMBRE PIC X(20).
  58.        01 HASTA-NOMBRE PIC X(20).
  59.  
  60.        PROCEDURE DIVISION.
  61.        DECLARATIVES.
  62.      *Estados de error del archivo
  63.        FILE-ERROR SECTION.
  64.            USE AFTER STANDARD ERROR PROCEDURE ON REG-LIBROS.
  65.            IF FS-REGISTRO-LIBROS EQUALS "35" THEN
  66.                SET F-NOEXISTE-REG TO TRUE
  67.            END-IF.
  68.        END DECLARATIVES.
  69.      *LOGICA PRINCIPAL
  70.        MENU.
  71.            PERFORM UNTIL CONTINUAR = "N"
  72.            PERFORM LIMPIAR-PANTALLA
  73.            DISPLAY "ADMINISTRADOR DE CATALOGO" AT LINE 1 COL 1 WITH
  74.                                                            REVERSE-VIDEO
  75.            DISPLAY " "                         AT LINE 3 COL 1
  76.            DISPLAY "1.Registrar, Editar, Remplazar libro" AT LINE 4
  77.                                                            COL 1
  78.            DISPLAY "2.Eliminar libro"          AT LINE 5 COL 1
  79.            DISPLAY "3.Ver catalogo"            AT LINE 6 COL 1
  80.            DISPLAY "4.Crear nuevo registro"    AT LINE 7 COL 1
  81.            DISPLAY "5.Buscar libro"            AT LINE 8  
  82.            DISPLAY "0.Salir"                   AT LINE 9 COL 1
  83.            DISPLAY " "                         AT LINE 10 COL 1
  84.            DISPLAY "Ingrese tecla ( )"         AT LINE 11 COL 1 WITH
  85.                                                            REVERSE-VIDEO
  86.            ACCEPT OPC                          AT LINE 11 COL 16 WITH
  87.                                                PROMPT UNDERLINE
  88.            EVALUATE OPC
  89.            WHEN 1 PERFORM REGISTRAR-LIBRO
  90.            WHEN 2 PERFORM ELIMINAR-LIBRO
  91.            WHEN 3 PERFORM VER-LIBROS
  92.            WHEN 4 PERFORM CREAR-ARCHIVO
  93.            WHEN 5 PERFORM BUSCAR-LIBRO
  94.            WHEN 0 MOVE "N" TO CONTINUAR
  95.            END-EVALUATE
  96.            END-PERFORM.
  97.            CLOSE REG-LIBROS.
  98.            STOP RUN.
  99.  
  100.  
  101.        REGISTRAR-LIBRO.
  102.            MOVE SPACES TO DATOS-LIBRO.
  103.            PERFORM LIMPIAR-PANTALLA.
  104.            MOVE "S" TO CONTINUAR-REG.
  105.      *************************************************************************    
  106.      *INTERFAZ MENU DE INGRESO DE DATOS
  107.      *************************************************************************
  108.            DISPLAY "Numero de serie:" AT LINE 1 COL 1.
  109.            DISPLAY "Nombre:"       AT LINE 2 COL 1.
  110.            DISPLAY "Editorial:"    AT LINE 3 COL 1.
  111.            DISPLAY "Estado:"       AT LINE 4 COL 1.
  112.            DISPLAY
  113.            "presione ENTER sin ingresar datos para salir al menu"
  114.                                                AT LINE 7 COL 12
  115.                                                      WITH REVERSE-VIDEO.
  116.  
  117.  
  118.            DISPLAY "Numero de serie    :" AT LINE 1 COL 1 WITH
  119.                                                           REVERSE-VIDEO.
  120.            initialize DATOS-LIBRO                                                
  121.            ACCEPT LIBRO-ID WITH PROMPT UNDERLINE UPDATE AT LINE 1
  122.                                                        COL 25.
  123.            
  124.            IF LIBRO-ID EQUALS 000 MOVE "N" TO CONTINUAR-REG END-IF.
  125.  
  126.  
  127.            IF CONTINUAR-REG EQUALS "S"
  128.               PERFORM ABRIR-IO-ARCHIVO                                          
  129.               read REG-LIBROS end-read
  130.               if ESTA-REG THEN
  131.                   DISPLAY NOMBRE              AT LINE 2 COL 25
  132.                   DISPLAY EDITORIAL           AT LINE 3 COL 25
  133.                   DISPLAY ESTADO              AT LINE 4 COL 25      
  134.               end-if
  135.               DISPLAY "Numero de serie    :" AT LINE 1 COL 1
  136.               DISPLAY LIBRO-ID            AT LINE 1 COL 25
  137.  
  138.               DISPLAY "Nombre    :"     AT LINE 2 COL 1
  139.                                             WITH REVERSE-VIDEO
  140.               ACCEPT NOMBRE               AT LINE 2 COL 25
  141.               DISPLAY "Nombre:    "       AT LINE 2 COL 1
  142.               DISPLAY NOMBRE              AT LINE 2 COL 25
  143.  
  144.               DISPLAY "Editorial    :"  AT LINE 3 COL 1
  145.                                             WITH REVERSE-VIDEO
  146.               ACCEPT EDITORIAL            AT LINE 3 COL 25
  147.               DISPLAY "Editorial    :"    AT LINE 3 COL 1
  148.               DISPLAY EDITORIAL           AT LINE 3 COL 25
  149.  
  150.               DISPLAY "Estado    :"     AT LINE 4 COL 1
  151.                                             WITH REVERSE-VIDEO
  152.               ACCEPT ESTADO               AT LINE 4 COL 25
  153.               DISPLAY "Estado    :"       AT LINE 4 COL 1
  154.               DISPLAY ESTADO              AT LINE 4 COL 25
  155.      *************************************************************************
  156.    
  157.              if N-ESTA-REG then
  158.               WRITE DATOS-LIBRO end-write
  159.              else
  160.                REWRITE DATOS-LIBRO END-REWRITE
  161.              end-if    
  162.              if not ESTA-REG then
  163.                    PERFORM LIMPIAR-PANTALLA
  164.                    DISPLAY "ERROR AL REGISTRAR DATOS" AT LINE 1 COL 1
  165.                                            WITH BACKGROUND-COLOR 4
  166.              end-if
  167.             PERFORM CERRAR-ARCHIVO
  168.            END-IF.
  169.            
  170.  
  171.        VER-LIBROS.
  172.            PERFORM ABRIR-ARCHIVO-INPUT.
  173.            IF F-NOEXISTE-REG THEN
  174.                PERFORM LIMPIAR-PANTALLA
  175.                DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS"
  176.                        WITH BACKGROUND-COLOR 4 AT LINE 1 COL 1
  177.  
  178.  
  179.  
  180.                DISPLAY "Presione ENTER para salir al menu"
  181.                                                AT LINE 7 COL 12 WITH
  182.                                                REVERSE-VIDEO
  183.                ACCEPT OPC AT LINE  10 COL 34
  184.            ELSE
  185.                PERFORM LIMPIAR-PANTALLA
  186.                INITIALIZE LIBRO-ID
  187.                START REG-LIBROS KEY IS >= LIBRO-ID END-START
  188.                READ REG-LIBROS NEXT RECORD END-READ
  189.                DISPLAY
  190.                "ID |TITULO            |EDITORIAL          |ESTADO     "
  191.                WITH REVERSE-VIDEO AT LINE 1 COL 1
  192.                PERFORM VARYING N FROM 02 BY 1 UNTIL FIN-REG
  193.                    DISPLAY DATOS-LIBRO AT LINE N COL 1
  194.                    READ REG-LIBROS NEXT RECORD END-READ
  195.                END-PERFORM
  196.                ADD 1 TO N
  197.                DISPLAY "Presione ENTER para salir al menu"
  198.                                                AT LINE N COL 1 WITH
  199.                                                REVERSE-VIDEO
  200.                ACCEPT OPC AT LINE N COL 34
  201.                PERFORM CERRAR-ARCHIVO
  202.            END-IF.
  203.  
  204.  
  205.        ELIMINAR-LIBRO.
  206.            PERFORM ABRIR-IO-ARCHIVO.
  207.            PERFORM LIMPIAR-PANTALLA.
  208.            MOVE SPACES TO DATOS-LIBRO
  209.  
  210.            DISPLAY "Indique por id el libro que desea eliminar:"
  211.            WITH REVERSE-VIDEO AT LINE 1 COL 1.
  212.            DISPLAY "Presione ENTER para salir al menu"
  213.            WITH REVERSE-VIDEO AT LINE 7 COL 12.
  214.                      
  215.            ACCEPT LIBRO-ID AT LINE 1 COL 46 WITH PROMPT UNDERLINE UPDATE.
  216.            
  217.            IF LIBRO-ID NOT EQUALS 000    
  218.            
  219.            PERFORM LIMPIAR-PANTALLA
  220.  
  221.            START REG-LIBROS KEY IS = LIBRO-ID
  222.            READ REG-LIBROS END-READ
  223.            IF ESTA-REG
  224.                DISPLAY
  225.                "ID |TITULO            |EDITORIAL         |ESTADO     "
  226.                                    WITH REVERSE-VIDEO AT LINE 1 COL 1
  227.                DISPLAY DATOS-LIBRO AT LINE 2 COL 1
  228.                DISPLAY "ELIMINAR(1)|VOLVER(0) :" AT LINE 5 COL 1
  229.                                                    WITH REVERSE-VIDEO
  230.                
  231.                ACCEPT ELIMINAR-OPC AT LINE 5 COL 25
  232.                EVALUATE ELIMINAR-OPC
  233.                    WHEN 1
  234.                    DISPLAY LIMPIAR-LINEA AT LINE 10 COL 1
  235.                    DELETE REG-LIBROS INVALID KEY
  236.                        DISPLAY "ERROR AL ELIMINAR" AT LINE 5 COL 1
  237.                    END-DELETE
  238.                    DISPLAY "REGISTRO ELIMINADO CON EXITO" AT LINE 5
  239.                                                 COL 1
  240.                                                 WITH BACKGROUND-COLOR 2
  241.                            ACCEPT OPC AT LINE 5 COL 29
  242.                    WHEN 0 PERFORM ELIMINAR-LIBRO
  243.            ELSE
  244.                DISPLAY "EL REGISTRO NO EXISTE" AT LINE 1 COL 1
  245.                                            WITH BACKGROUND-COLOR 4
  246.                            ACCEPT OPC AT LINE 1 COL 22
  247.            END-IF
  248.            
  249.            END-IF.
  250.            PERFORM CERRAR-ARCHIVO.
  251.            
  252.  
  253.        CREAR-ARCHIVO.
  254.            PERFORM ABRIR-IO-ARCHIVO
  255.            IF NOT F-NOEXISTE-REG THEN
  256.                PERFORM LIMPIAR-PANTALLA
  257.                DISPLAY "SE DETECTO UN ARCHIVO EXISTENTE, DE PROCEDER EL"
  258.                AT LINE 1 COL 1 WITH BACKGROUND-COLOR 6
  259.                " ARCHIVO ACTUAL SERA ELIMINADO" AT LINE 1 COL 48
  260.                                WITH BACKGROUND-COLOR 6
  261.                DISPLAY "ELIMINAR(1)|SALIR AL MENU(0) :" AT LINE 10 COL 1
  262.                                                    WITH REVERSE-VIDEO
  263.                ACCEPT ELIMINAR-OPC AT LINE 10 COL 31
  264.                EVALUATE ELIMINAR-OPC
  265.                    WHEN 1
  266.                    PERFORM CERRAR-ARCHIVO
  267.                    OPEN OUTPUT REG-LIBROS
  268.                    PERFORM CERRAR-ARCHIVO
  269.                    PERFORM LIMPIAR-PANTALLA
  270.                    DISPLAY "ARCHIVO CREADO CON EXITO."
  271.                                                WITH BACKGROUND-COLOR 2
  272.                    ACCEPT OPC AT LINE 1 COL 27
  273.                    WHEN 0 PERFORM CERRAR-ARCHIVO EXIT
  274.            ELSE
  275.                OPEN OUTPUT REG-LIBROS
  276.                CLOSE REG-LIBROS
  277.                PERFORM LIMPIAR-PANTALLA
  278.                DISPLAY "ARCHIVO CREADO CON EXITO."
  279.                                                WITH BACKGROUND-COLOR 2
  280.                ACCEPT OPC AT LINE 1 COL 27
  281.            END-IF.
  282.  
  283.        BUSCAR-LIBRO.
  284.            PERFORM LIMPIAR-PANTALLA.
  285.            PERFORM ABRIR-ARCHIVO-INPUT.
  286.            MOVE SPACES TO DATOS-LIBRO.
  287.            
  288.            IF ESTA-REG
  289.                DISPLAY "MENU DE BUSQUEDA" AT LINE 1 COL 1
  290.                                        WITH REVERSE-VIDEO
  291.                DISPLAY "(I)Busqueda por id" AT LINE 3 COL 1
  292.                DISPLAY "(N)Busqueda por nombre" AT LINE 4 COL 1
  293.                DISPLAY "(E)Busqueda por editorial" AT LINE 5 COL 1
  294.                DISPLAY "Ingrese opcion( )" AT LINE 7 COL 1
  295.                                        WITH REVERSE-VIDEO
  296.                ACCEPT BUSCAR-OPC AT LINE 7 COL 16
  297.                IF BUSCAR-OPC EQUALS "i" MOVE "I" TO BUSCAR-OPC END-IF
  298.                IF BUSCAR-OPC EQUALS "n" MOVE "N" TO BUSCAR-OPC END-IF
  299.                IF BUSCAR-OPC EQUALS "e" MOVE "E" TO BUSCAR-OPC END-IF
  300.                
  301.                EVALUATE BUSCAR-OPC
  302.                WHEN "I"
  303.                
  304.                WHEN "N"
  305.                
  306.                WHEN "E"
  307.                PERFORM BUSCAR-NOMBRE
  308.                END-EVALUATE
  309.                
  310.                
  311.                
  312.                
  313.                
  314.            ELSE
  315.                DISPLAY "ERROR, NO EXISTE UN ARCHIVO DE REGISTROS"
  316.                                  AT LINE 1 COL 1 WITH BACKGROUND-COLOR 4
  317.                ACCEPT OPC AT LINE 1 COL 43
  318.            END-IF.
  319.      *************************************************************************        
  320.      *BLOQUE DE CODIGO DE BUSQUEDAS
  321.      *************************************************************************        
  322.        BUSCAR-NOMBRE.
  323.              PERFORM LIMPIAR-PANTALLA.
  324.            PERFORM ABRIR-ARCHIVO-INPUT.
  325.            MOVE SPACES TO DATOS-LIBRO
  326.            DISPLAY "Titulo:   " AT LINE 2 COL 1 WITH REVERSE-VIDEO
  327.            DISPLAY "---------------------------------------------------"
  328.                                                AT LINE 3 COL 1.
  329.  
  330.            DISPLAY
  331.                "ID |TITULO            |EDITORIAL         |ESTADO     "
  332.                                    WITH REVERSE-VIDEO AT LINE 3 COL 1.
  333.            ACCEPT DESDE-NOMBRE AT LINE 2 COL 14.
  334.            MOVE DESDE-NOMBRE TO NOMBRE.
  335.            MOVE NOMBRE TO HASTA-NOMBRE.
  336.            START REG-LIBROS KEY IS >= NOMBRE END-START.
  337.            READ REG-LIBROS NEXT RECORD END-READ.
  338.            PERFORM VARYING N FROM 01 BY 1 UNTIL FIN-REG OR
  339.                                           NOMBRE > HASTA-NOMBRE
  340.                DISPLAY DATOS-LIBRO AT LINE 4 COL 1
  341.  
  342.                READ REG-LIBROS NEXT RECORD END-READ
  343.            END-PERFORM.
  344.                
  345.                ACCEPT OPC AT LINE 10 COL 1.
  346.            PERFORM CERRAR-ARCHIVO.
  347.      *************************************************************************
  348.        LIMPIAR-PANTALLA.
  349.            PERFORM VARYING N FROM 01 BY 1 UNTIL N>24
  350.                DISPLAY LIMPIAR AT LINE N COLUMN 1
  351.            END-PERFORM.
  352.                
  353.        ABRIR-ARCHIVO-INPUT.
  354.            OPEN INPUT REG-LIBROS.
  355.  
  356.        ABRIR-IO-ARCHIVO.
  357.            OPEN I-O REG-LIBROS.
  358.  
  359.        CERRAR-ARCHIVO.
  360.            CLOSE REG-LIBROS.
  361.            
JCantero is offline   Responder Con Cita