Carlos:
Este curso fue muy, muy bueno eres detallista, nos llevaste de la mano en un ambiente complejo.
Excelente curso introductorio
Excelente profesor.
Me encanto que nos resuelvas las dudas directamente.
Tus primeros pasos con COBOL
Importancia de aprender COBOL en la actualidad
Estructura de un programa en COBOL
Descarga y configuración del entorno de desarrollo en Windows
Descarga y configuración del entorno de desarrollo: X3270
Descarga y configuración del entorno de desarrollo en Ubuntu
Descarga y configuración del entorno de desarrollo en macOS
Conociendo el entorno de COBOL: Hercules / MVS
Comandos del entorno: MVS a detalle
Conociendo la consola de visualización y línea de comandos
Pasos para ejecutar un programa COBOL
"Hola, mundo" en COBOL
Quiz: Tus primeros pasos con COBOL
JCL: Job Control Language
¿Qué es un JCL?
Estructura de un JCL
Utilerías: IEFBR14
Utilerías: IEBGENER
Definiendo tu primer JCL
Definiendo el JCL de ejecución
Quiz: JCL: Job Control Language
Tipos de datos y operaciones matemáticas
Tipos de datos y convenciones
DISPLAY: imprimiendo las variables en pantalla
Operaciones matemáticas
Quiz: Tipos de datos y operaciones matemáticas
Estructuras de control
IF - ELSE
PERFORM
Algoritmos y resolución de problemas
Top-down y modularización
Quiz: Algoritmos y resolución de problemas
Despedida
Siguientes pasos en COBOL
No tienes acceso a esta clase
¡Continúa aprendiendo! Únete y comienza a potenciar tu carrera
Si ya tienes una cuenta,
Siguientes pasos en COBOL
24/24Recursos
Aportes 17
Preguntas 1
Ordenar por:
Este curso estuvo excelente y muy detallado para un lenguaje que tiene muchas condiciones a la hora de codificar y compilar, es por esto que se encuentran pocos cursos de este lenguaje. Simplemente me encantó aunque me tardé en unas clases por errores que al final del día era falta de puntos o mal uso de columnas.
Muchas gracias por este curso, su tiempo y paciencia
Excelente… me ayudo mucho con la parte de los JCL
Profesor, muchas gracias por este curso me encanto, me ayudo bastante. El honor es todo mío. Nos vemos en más cursos.
les mando este codigo fuente de cobol que hice en 1997
IDENTIFICATION DIVISION.
PROGRAM-ID. MENCON.
AUTHOR. MARTIN RAMIREZ**2.
************************************************
** **
** MENU GENERAL DE CONTABILIDAD GENERAL **
** **
************************************************
DATE-WRITTEN. 97/12/02.
DATE-COMPILED.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-PC.
OBJECT-COMPUTER. IBM-PC.
SPECIAL-NAMES.
CRT STATUS IS key-status.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FECHAS ASSIGN TO DISK
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
SELECT MENUSS ASSIGN TO DISK
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
SELECT SEGURI ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS CLASEG
ALTERNATE RECORD KEY IS SEGAUX = PASSEG
FILE STATUS IS FS-SEGURI.
DATA DIVISION.
FILE SECTION.
FD FECHAS
LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS ARCFEC
RECORD CONTAINS 15 CHARACTERS
DATA RECORD IS REGFEC.
01 REGFEC.
02 FECCIA PIC 9(06).
02 FECCIAR REDEFINES FECCIA.
03 DIACIA PIC 9(02).
03 MESCIA PIC 9(02).
03 ANOCIA PIC 9(02).
FD MENUSS
LABEL RECORDS ARE STANDARD
VALUE OF FILE-ID IS ARCMEN
RECORD CONTAINS 71 CHARACTERS
DATA RECORD ARE REGME1 REGME2 REGME3.
01 REGME1.
02 LINPR1 PIC 9(02).
02 LINUL1 PIC 9(02).
02 FILLER PIC X(01).
02 COLUM1 PIC 9(02).
02 ANCHO1 PIC 9(02).
02 FILLER PIC X(01).
02 LINOP1 PIC 9(02).
02 COLOP1 PIC 9(02).
01 REGME2.
02 LINEA2 PIC 9(02).
02 COLUM2 PIC 9(02).
02 TIPLI2 PIC X(01).
02 DESCR2 PIC X(66).
01 REGME3.
02 OPCME3 PIC 9(02).
02 FILLER PIC X(01).
02 NUMSG3 PIC 9(01).
02 FILLER PIC X(01).
02 PROGR3 PIC X(10).
02 FILLER PIC X(01).
02 SGUNO3 PIC 9(03).
02 FILLER PIC X(01).
02 SGDOS3 PIC 9(03).
02 FILLER PIC X(01).
02 SGTRE3 PIC 9(03).
02 FILLER PIC X(01).
02 SGCUA3 PIC 9(03).
02 FILLER PIC X(01).
02 SGCIN3 PIC 9(03).
COPY FDSEG.CPY.
WORKING-STORAGE SECTION.
01 ARCFEC.
02 ARCFE0 PIC X(16).
02 ARCFE1 PIC X(10) VALUE "FECHAS.SEQ".
01 ARCMEN.
02 ARCME0 PIC X(10).
01 FS-SEGURI.
02 FS-SEGUR1 PIC X(01).
02 FS-SEGUR2 PIC X(01).
02 FS-SEGUR3 REDEFINES FS-SEGUR2 PIC 9(02) COMP-X.
01 EXISTE PIC X(08) COMP-X.
01 XXXXXX PIC X(10).
COPY PARAME.CPY.
01 I PIC 9(05) VALUE ZEROS.
01 J PIC 9(05) VALUE ZEROS.
01 K PIC 9(05) VALUE ZEROS.
01 L PIC 9(05) VALUE ZEROS.
01 M PIC 9(05) VALUE ZEROS.
01 ACC PIC S9(02).
01 MAL PIC 9(02) VALUE ZEROS.
01 WIN PIC S9(02).
01 ACCION PIC X(13).
01 CAMPOX PIC X(01).
01 NOEXIS PIC 9(02).
01 NUMERO PIC 9(02).
01 LINOPC PIC 9(02).
01 COLOPC PIC 9(02).
01 OPCION PIC 9(01).
88 OPC VALUES ARE 1 THRU 2.
88 OPCZ VALUE IS 99.
01 OPCION2 PIC 9(02).
88 OPC2 VALUES ARE 01 THRU 59.
88 OPC2Z VALUE IS 99.
01 RESULT PIC 9(04)V9(10).
01 RESULTR REDEFINES RESULT.
02 RESUL1 PIC 9(04).
02 RESUL2 PIC 9(10).
01 TABDIA.
02 FILLER PIC X(26) VALUE
"31283130313031313031303131".
01 TABDIAR REDEFINES TABDIA.
02 DIAMES PIC X(02) OCCURS 13 TIMES.
01 FECHAM PIC 9(06).
01 FECHAMR REDEFINES FECHAM.
02 ANOM PIC 9(02).
02 MESM PIC 9(02).
02 DIAM PIC 9(02).
01 HORASM PIC X(04).
01 HORASS REDEFINES HORASM PIC 9(02)V9(02).
01 DIASSM PIC 9(05).
01 WCLAVE.
02 WCLAV1 PIC X(01).
02 WCLAV2 PIC X(01).
02 WCLAV3 PIC X(01).
02 WCLAV4 PIC X(01).
02 WCLAV5 PIC X(01).
01 WPASSW.
02 WPASS1 PIC 9(03).
02 WPASS2 PIC 9(03).
02 WPASS3 PIC 9(03).
02 WPASS4 PIC 9(03).
02 WPASS5 PIC 9(03).
* utilerias de cobol
* ventana 1
01 win-1.
02 datw1 PIC 9(04) COMP-X VALUE 0.
02 bufw1 PIC X(2000).
02 atrw1 PIC X(2000).
02 lonw1 PIC 9(04) COMP-X VALUE 2000.
* ventana 2
01 win-2.
02 datw2 PIC 9(04) COMP-X VALUE 0.
02 bufw2 PIC X(2000).
02 atrw2 PIC X(2000).
02 lonw2 PIC 9(04) COMP-X VALUE 2000.
* status del accept
01 key-status.
03 key-type PIC X(01).
03 key-code-1 PIC 9(02) comp-x.
03 key-code-2 PIC 9(02) comp-x.
* sombras
01 screen-position.
03 row-number PIC X(01) comp-x.
03 col-number PIC X(01) comp-x.
01 attribute PIC X(80) value all X"08".
01 string-length PIC X(02) comp-x.
01 status-code PIC S9(04) comp.
* define flechas como funci¢n
01 set-bit-pairs pic 9(02) comp-x value 1.
01 adis-key.
03 adis-key-set pic 9(02) comp-x.
03 filler pic X(01) value "2".
03 first-adis pic 9(02) comp-x.
03 number-adis pic 9(02) comp-x.
* fin de utilerias de cobol
01 TABPRO.
02 NOMPRO PIC X(10) OCCURS 60 TIMES.
02 NUMOPC PIC 9(01) OCCURS 60 TIMES.
02 OPCUNO PIC 9(03) OCCURS 60 TIMES.
02 OPCDOS PIC 9(03) OCCURS 60 TIMES.
02 OPCTRE PIC 9(03) OCCURS 60 TIMES.
02 OPCCUA PIC 9(03) OCCURS 60 TIMES.
02 OPCCIN PIC 9(03) OCCURS 60 TIMES.
01 TABNOM.
02 FILLER PIC X(55) VALUE
"ÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþ".
02 FILLER PIC X(07) VALUE
'!"#$%&'.
02 FILLER PIC X(49) VALUE
"'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVW".
02 FILLER PIC X(56) VALUE
"XYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ €‚ƒ„…†‡ˆ‰Š‹ŒŽ".
02 FILLER PIC X(56) VALUE
"‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦§¨©ª«¬®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇ".
01 NOMTAB REDEFINES TABNOM.
02 NOMBR PIC X(01) OCCURS 223 TIMES.
01 TABMES.
02 FILLER PIC X(10) VALUE " ENERO ".
02 FILLER PIC X(10) VALUE " FEBRERO ".
02 FILLER PIC X(10) VALUE " MARZO ".
02 FILLER PIC X(10) VALUE " ABRIL ".
02 FILLER PIC X(10) VALUE " MAYO ".
02 FILLER PIC X(10) VALUE " JUNIO ".
02 FILLER PIC X(10) VALUE " JULIO ".
02 FILLER PIC X(10) VALUE " AGOSTO ".
02 FILLER PIC X(10) VALUE "SEPTIEMBRE".
02 FILLER PIC X(10) VALUE " OCTUBRE ".
02 FILLER PIC X(10) VALUE "NOVIEMBRE ".
02 FILLER PIC X(10) VALUE "DICIEMBRE ".
02 FILLER PIC X(10) VALUE " CIERRE ".
01 MESTAB REDEFINES TABMES.
02 MESES PIC X(10) OCCURS 13 TIMES.
SCREEN SECTION.
01 VIDEO-FECHA.
02 BACKGROUND-COLOR 1 FOREGROUND-COLOR 3.
03 REVERSE-VIDEO.
04 LINE 02 COLUMN 72 PIC 9(02)
USING DIACIA AUTO BELL.
04 LINE 02 COLUMN 75 PIC 9(02)
USING MESCIA AUTO.
04 LINE 02 COLUMN 78 PIC 9(02)
USING ANOCIA AUTO.
01 VIDEO-DERECH.
02 BACKGROUND-COLOR 4 FOREGROUND-COLOR 7.
02 LINE 04 COLUMN 03 VALUE
" ".
02 LINE 05 COLUMN 03 VALUE
" ".
02 LINE 06 COLUMN 03 VALUE
" CONTABILIDAD INFORMATICA (97) ".
02 LINE 07 COLUMN 03 VALUE
" ".
02 LINE 08 COLUMN 03 VALUE
" Realizado por : ".
02 LINE 09 COLUMN 03 VALUE
" ".
02 LINE 10 COLUMN 03 VALUE
" ÄÍð GRUPO INFORMATICO ÄÍð ".
02 LINE 11 COLUMN 03 VALUE
" ".
02 LINE 12 COLUMN 03 VALUE
" Coatepec 43A-1 Fracc. Veracruz ".
02 LINE 13 COLUMN 03 VALUE
" Xalapa, 91020, Ver. Tel. (28) 14-71-04 ".
02 LINE 14 COLUMN 03 VALUE
" ".
02 LINE 15 COLUMN 03 VALUE
" Version (4.1) 1997 Derechos Reservados. ".
02 LINE 16 COLUMN 03 VALUE
" Este programa esta registrado en la ".
02 LINE 17 COLUMN 03 VALUE
" Secretaria de Educaci¢n P£blica (SEP) ".
02 LINE 18 COLUMN 03 VALUE
" Conforme acuerdo Num. 114. ".
02 LINE 19 COLUMN 03 VALUE
" ".
02 LINE 20 COLUMN 03 VALUE
" SE PROHIBE LA REPRODUCCION TOTAL O PARCIAL ".
02 LINE 21 COLUMN 03 VALUE
" DE ESTE PROGRAMA BAJO SANCION DE LEY. ".
02 LINE 22 COLUMN 03 VALUE
" ".
02 LINE 23 COLUMN 03 VALUE
" ".
02 LINE 24 COLUMN 03 VALUE
" ".
01 VIDEO-OPCION.
02 BACKGROUND-COLOR 0 FOREGROUND-COLOR 8.
03 LINE 06 COLUMN 26 VALUE " ".
03 LINE 07 COLUMN 26 VALUE " ".
03 LINE 08 COLUMN 26 VALUE " ".
02 BACKGROUND-COLOR 7 FOREGROUND-COLOR 8.
03 LINE 05 COLUMN 27 VALUE "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»".
03 LINE 06 COLUMN 27 VALUE "º C O N T A B I L I D A D º".
03 LINE 07 COLUMN 27 VALUE "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ".
02 BACKGROUND-COLOR 8 FOREGROUND-COLOR 8.
03 LINE 12 COLUMN 04 VALUE " ".
03 LINE 13 COLUMN 04 VALUE " ".
03 LINE 14 COLUMN 04 VALUE " ".
02 BACKGROUND-COLOR 7 FOREGROUND-COLOR 15.
03 LINE 11 COLUMN 05 VALUE "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»".
03 LINE 12 COLUMN 05 VALUE "º ACTUALIZACIONES º".
03 LINE 13 COLUMN 05 VALUE "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ".
02 BACKGROUND-COLOR 7 FOREGROUND-COLOR 4.
03 LINE 12 COLUMN 07 VALUE "A".
02 BACKGROUND-COLOR 8 FOREGROUND-COLOR 8.
03 LINE 12 COLUMN 26 VALUE " ".
03 LINE 13 COLUMN 26 VALUE " ".
03 LINE 14 COLUMN 26 VALUE " ".
02 BACKGROUND-COLOR 7 FOREGROUND-COLOR 15.
03 LINE 11 COLUMN 27 VALUE "ÉÍÍÍÍÍÍÍÍÍÍÍ»".
03 LINE 12 COLUMN 27 VALUE "º CONSULTAS º".
03 LINE 13 COLUMN 27 VALUE "ÈÍÍÍÍÍÍÍÍÍÍͼ".
02 BACKGROUND-COLOR 7 FOREGROUND-COLOR 4.
03 LINE 12 COLUMN 29 VALUE "C".
02 BACKGROUND-COLOR 8 FOREGROUND-COLOR 8.
03 LINE 12 COLUMN 42 VALUE " ".
03 LINE 13 COLUMN 42 VALUE " ".
03 LINE 14 COLUMN 42 VALUE " ".
02 BACKGROUND-COLOR 7 FOREGROUND-COLOR 15.
03 LINE 11 COLUMN 43 VALUE "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍ»".
03 LINE 12 COLUMN 43 VALUE "º IMPRESIONES º".
03 LINE 13 COLUMN 43 VALUE "ÈÍÍÍÍÍÍÍÍÍÍÍÍͼ".
02 BACKGROUND-COLOR 7 FOREGROUND-COLOR 4.
03 LINE 12 COLUMN 45 VALUE "I".
02 BACKGROUND-COLOR 8 FOREGROUND-COLOR 8.
03 LINE 12 COLUMN 60 VALUE " ".
03 LINE 13 COLUMN 60 VALUE " ".
03 LINE 14 COLUMN 60 VALUE " ".
02 BACKGROUND-COLOR 7 FOREGROUND-COLOR 15.
03 LINE 11 COLUMN 61 VALUE "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»".
03 LINE 12 COLUMN 61 VALUE "º ADMINISTRADOR º".
03 LINE 13 COLUMN 61 VALUE "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ".
02 BACKGROUND-COLOR 7 FOREGROUND-COLOR 4.
03 LINE 12 COLUMN 64 VALUE "D".
PROCEDURE DIVISION CHAINING PARAME.
INICIO.
PERFORM DEFINE-FUNCIONES
ACCEPT FECHAM FROM DATE
ACCEPT HORASM FROM TIME
ACCEPT DIASSM FROM DAY
.
MOVE SUBCIA TO ARCFE0
OPEN INPUT FECHAS
READ FECHAS AT END MOVE 1 TO I.
CLOSE FECHAS
.
-
MOVE DIAM TO DIACIA -
MOVE MESM TO MESCIA -
MOVE ANOM TO ANOCIA DISPLAY VIDEO-FECHA . PERFORM GUARDA-WIN1 PERFORM CHECA-SEGURI DISPLAY VIDEO-DERECH PERFORM PEDIR-PASSWD IF MAL = ZEROS PERFORM PINTA-WIN1 DISPLAY VIDEO-OPCION PERFORM GUARDA-WIN2 PERFORM MUEVE-PARAME MOVE ZEROS TO OPCION PERFORM PROCESO UNTIL OPCION = 1 ACCEPT FECHAM FROM DATE ACCEPT HORASM FROM TIME ACCEPT DIASSM FROM DAY MOVE FECHAM TO UFESEG MOVE HORASS TO UHRSEG PERFORM GRABA-SEGURI OPEN OUTPUT FECHAS WRITE REGFEC CLOSE FECHAS . DISPLAY (01, 01) " " WITH BLANK SCREEN EXIT PROGRAM . PROCESO. DISPLAY VIDEO-FECHA PERFORM GUARDA-WIN2 MOVE ZEROS TO WIN OPCION MAL PERFORM PEDIR-OPCION UNTIL OPC PERFORM CHECA-FECHAS IF WIN = 1 MOVE "MENACT.SEQ" TO ARCME0 . IF WIN = 2 MOVE "MENCON.SEQ" TO ARCME0 . IF WIN = 3 MOVE "MENIMP.SEQ" TO ARCME0 . IF WIN = 4 MOVE "MENADM.SEQ" TO ARCME0 . IF MAL = ZEROS AND WIN NOT = ZEROS PERFORM DESP-OPCIONES MOVE ZEROS TO OPCION2 PERFORM OPCIONES UNTIL OPCION2 = 99 . PERFORM PINTA-WIN2 . DESP-OPCIONES. OPEN INPUT MENUSS READ MENUSS AT END MOVE 1 TO I. move COLUM1 to col-number move ANCHO1 to string-length M perform varying I from LINPR1 by 1 until I > LINUL1 move I to row-number call "cbl_write_scr_attrs" using screen-position attribute string-length returning status-code end-perform COMPUTE J = LINUL1 - LINPR1 + 2 COMPUTE L = ANCHO1 - 2 MOVE LINOP1 TO LINOPC MOVE COLOP1 TO COLOPC PERFORM LEE-OPCIONES VARYING I FROM 1 BY 1 UNTIL I > J PERFORM LEE-PROGRAMAS VARYING I FROM 1 BY 1 UNTIL I > 60 CLOSE MENUSS . LEE-OPCIONES. READ MENUSS AT END MOVE 1 TO K . MOVE LINEA2 TO LIN MOVE COLUM2 TO COL IF TIPLI2 = "N" DISPLAY (LIN, COL) DESCR2 WITH SIZE M BACKGROUND-COLOR 7 FOREGROUND-COLOR 14 . IF TIPLI2 = "I" DISPLAY (LIN, COL) DESCR2 WITH SIZE L BACKGROUND-COLOR 7 FOREGROUND-COLOR 14 REVERSE-VIDEO . LEE-PROGRAMAS. READ MENUSS AT END MOVE 1 TO K . MOVE NUMSG3 TO NUMOPC (I) MOVE PROGR3 TO NOMPRO (I) MOVE SGUNO3 TO OPCUNO (I) MOVE SGDOS3 TO OPCDOS (I) MOVE SGTRE3 TO OPCTRE (I) MOVE SGCUA3 TO OPCCUA (I) MOVE SGCIN3 TO OPCCIN (I) . OPCIONES. MOVE ZEROS TO OPCION2 PERFORM PEDIR-OPCION2 UNTIL OPC2 OR OPC2Z . MOVE ZEROS TO MAL IF NOT OPC2Z IF NOMPRO (OPCION2) = "DATCIA.GNT" IF ACC001 NOT = "S" MOVE 1 TO MAL . IF NOT OPC2Z IF NOMPRO (OPCION2) = "CAMFEC.GNT" IF ACC002 NOT = "S" MOVE 1 TO MAL . IF NOT OPC2Z IF NOMPRO (OPCION2) = "ADMCON.GNT" IF ADMSEG NOT = "S" MOVE 1 TO MAL . IF NOT OPC2Z AND MAL = ZEROS AND NOMPRO (OPCION2) NOT = "NOVALE.GNT" PERFORM CHECA-FECHAS PERFORM CHECA-ACCESO IF MAL = ZEROS IF NOMPRO (OPCION2) = "CAMFEC.GNT" PERFORM PINTA-WIN1 PERFORM CAMBIA-FECHA PERFORM MUEVE-PARAME PERFORM GUARDA-WIN1 -
PERFORM PINTA-WIN2 -
DISPLAY VIDEO-FECHA -
PERFORM GUARDA-WIN2 MOVE 99 TO OPCION2 ELSE PERFORM CANCELA-FUNCIONES PERFORM MUEVE-PARAME2 CALL NOMPRO (OPCION2) USING PARAME CANCEL NOMPRO (OPCION2) PERFORM DEFINE-FUNCIONES IF NOMPRO (OPCION2) = "ADMCON.GNT" PERFORM MUEVE-PARAME END-IF . PEDIR-OPCION. ACCEPT (24, 02) CAMPOX WITH SECURE AUTO-SKIP DISPLAY (24, 02) " " . IF key-type = ZEROS IF key-code-1 = 48 AND key-code-2 = 13 MOVE 2 TO OPCION ELSE EVALUATE CAMPOX WHEN "A" MOVE 1 TO WIN WHEN "C" MOVE 2 TO WIN WHEN "I" MOVE 3 TO WIN WHEN "D" MOVE 4 TO WIN WHEN OTHER call x"e5" END-EVALUATE . IF key-type = 1 IF key-code-1 = ZEROS AND key-code-2 = ZEROS MOVE 1 TO OPCION ELSE IF key-code-1 = 30 AND key-code-2 = 30 IF CLASEG = "MRR" PERFORM CANCELA-FUNCIONES CALL "ADMCON.GNT" USING PARAME CANCEL "ADMCON.GNT" PERFORM DEFINE-FUNCIONES PERFORM LEE-SEGURI-IDX PERFORM MUEVE-PARAME ELSE call x"e5" ELSE call x"e5" . IF key-type = 2 EVALUATE key-code-1 WHEN 3 COMPUTE WIN = WIN - 1 IF WIN < 1 MOVE 4 TO WIN END-IF WHEN 4 COMPUTE WIN = WIN + 1 IF WIN > 4 MOVE 1 TO WIN END-IF WHEN 5 COMPUTE WIN = WIN - 1 IF WIN < 1 MOVE 4 TO WIN END-IF WHEN 6 COMPUTE WIN = WIN + 1 IF WIN > 4 MOVE 1 TO WIN END-IF WHEN OTHER call x"e5" END-EVALUATE . EVALUATE WIN WHEN 1 PERFORM PINTA-WIN2 DISPLAY (12, 07) "ACTUALIZACIONES" WITH BACKGROUND-COLOR 7 FOREGROUND-COLOR 5 WHEN 2 PERFORM PINTA-WIN2 DISPLAY (12, 29) "CONSULTAS" WITH BACKGROUND-COLOR 7 FOREGROUND-COLOR 5 WHEN 3 PERFORM PINTA-WIN2 DISPLAY (12, 45) "IMPRESIONES" WITH BACKGROUND-COLOR 7 FOREGROUND-COLOR 5 WHEN 4 PERFORM PINTA-WIN2 DISPLAY (12, 63) "ADMINISTRADOR" WITH BACKGROUND-COLOR 7 FOREGROUND-COLOR 5 END-EVALUATE . * DISPLAY (17, 01) "key-type " key-type * DISPLAY (18, 01) "key-code-1 " key-code-1 * DISPLAY (19, 01) "key-code-2 " key-code-2 * DISPLAY (21, 01) "claseg " CLASEG * DISPLAY (22, 01) "win " win . PEDIR-OPCION2. MOVE LINOPC TO LIN MOVE COLOPC TO COL ACCEPT (LIN, COL) OPCION2 WITH PROMPT AUTO-SKIP BEEP . IF key-type = ZEROS OR key-type = 1 IF OPCION2 = ZEROS MOVE 99 TO OPCION2 . PEDIR-PASSWD. MOVE ZEROS TO MAL DISPLAY (10, 50) " " DISPLAY (10, 50) "PASSWORD: [ ]" ACCEPT (10, 61) WCLAVE WITH PROMPT AUTO-SKIP BEEP NO-ECHO . PERFORM MUEVE-PASSEG PERFORM LEE-SEGURI-IDX IF NOEXIS = 1 MOVE 1 TO MAL . MUEVE-PASSEG. PERFORM BUSCA VARYING I FROM 1 BY 1 UNTIL I = 224 OR WCLAV1 = NOMBR (I) MOVE I TO WPASS1 PERFORM BUSCA VARYING I FROM 1 BY 1 UNTIL I = 224 OR WCLAV2 = NOMBR (I) MOVE I TO WPASS2 PERFORM BUSCA VARYING I FROM 1 BY 1 UNTIL I = 224 OR WCLAV3 = NOMBR (I) MOVE I TO WPASS3 PERFORM BUSCA VARYING I FROM 1 BY 1 UNTIL I = 224 OR WCLAV4 = NOMBR (I) MOVE I TO WPASS4 PERFORM BUSCA VARYING I FROM 1 BY 1 UNTIL I = 224 OR WCLAV5 = NOMBR (I) MOVE I TO WPASS5 MOVE WPASSW TO PASSEG . MUEVE-PARAME. MOVE FECCIA TO FECHA MOVE MESES (MES) TO NOMMES MOVE CLASEG TO CLAUSU MOVE ADMSEG TO ADMINI . MUEVE-PARAME2. MOVE "N" TO SEGUR1 SEGUR2 SEGUR3 SEGUR4 SEGUR5 IF OPCUNO (OPCION2) > ZEROS MOVE OPCUNO (OPCION2) TO I MOVE ACCSEG (I) TO SEGUR1 . IF OPCDOS (OPCION2) > ZEROS MOVE OPCDOS (OPCION2) TO I MOVE ACCSEG (I) TO SEGUR2 . IF OPCTRE (OPCION2) > ZEROS MOVE OPCTRE (OPCION2) TO I MOVE ACCSEG (I) TO SEGUR3 . IF OPCCUA (OPCION2) > ZEROS MOVE OPCCUA (OPCION2) TO I MOVE ACCSEG (I) TO SEGUR4 . IF OPCCIN (OPCION2) > ZEROS MOVE OPCCIN (OPCION2) TO I MOVE ACCSEG (I) TO SEGUR5 . CAMBIA-FECHA. ACCEPT VIDEO-FECHA DISPLAY VIDEO-FECHA COMPUTE RESULT = ANOCIA / 4 IF RESUL2 = ZEROS MOVE 29 TO DIAMES (2) ELSE MOVE 28 TO DIAMES (2) . IF MESCIA < 1 OR MESCIA > 13 GO TO CAMBIA-FECHA . IF DIACIA < 1 OR DIACIA > DIAMES (MESCIA) GO TO CAMBIA-FECHA . BUSCA. EXIT. CHECA-FECHAS. IF FECHAM < FEISEG OR FECHAM > FETSEG MOVE 1 TO MAL . IF HORASS < HRISEG OR HORASS > HRTSEG MOVE 1 TO MAL . CHECA-ACCESO. IF NUMOPC (OPCION2) = 1 MOVE OPCUNO (OPCION2) TO I IF ACCSEG (I) = "N" MOVE 1 TO MAL . IF NUMOPC (OPCION2) = 2 MOVE OPCUNO (OPCION2) TO I MOVE OPCDOS (OPCION2) TO J IF ACCSEG (I) = "N" AND ACCSEG (J) = "N" MOVE 1 TO MAL . IF NUMOPC (OPCION2) = 3 MOVE OPCUNO (OPCION2) TO I MOVE OPCDOS (OPCION2) TO J MOVE OPCTRE (OPCION2) TO K IF ACCSEG (I) = "N" AND ACCSEG (J) = "N" AND ACCSEG (K) = "N" MOVE 1 TO MAL . IF NUMOPC (OPCION2) = 4 MOVE OPCUNO (OPCION2) TO I MOVE OPCDOS (OPCION2) TO J MOVE OPCTRE (OPCION2) TO K MOVE OPCCUA (OPCION2) TO L IF ACCSEG (I) = "N" AND ACCSEG (J) = "N" AND ACCSEG (K) = "N" AND ACCSEG (L) = "N" MOVE 1 TO MAL . IF NUMOPC (OPCION2) = 5 MOVE OPCUNO (OPCION2) TO I MOVE OPCDOS (OPCION2) TO J MOVE OPCTRE (OPCION2) TO K MOVE OPCCUA (OPCION2) TO L MOVE OPCCIN (OPCION2) TO M IF ACCSEG (I) = "N" AND ACCSEG (J) = "N" AND ACCSEG (K) = "N" AND ACCSEG (L) = "N" AND ACCSEG (M) = "N" MOVE 1 TO MAL . CHECA-SEGURI. MOVE ZEROS TO MAL CALL "CBL_CHECK_FILE_EXIST" USING "SEGCON.DAT" EXISTE IF EXISTE = ZEROS MOVE 1 TO MAL ELSE OPEN I-O SEGURI MOVE LOW-VALUES TO CLASEG PERFORM POSIC-SEGURI IF I = ZEROS NEXT SENTENCE ELSE MOVE 1 TO MAL . IF MAL = 1 PERFORM MUEVE-PARAME DISPLAY (01, 01) " " WITH BLANK SCREEN PERFORM CANCELA-FUNCIONES CALL "ADMCON.GNT" USING PARAME CANCEL "ADMCON.GNT" PERFORM LEE-SEGURI-IDX STOP RUN . POSIC-SEGURI. MOVE ZEROS TO I START SEGURI KEY IS NOT LESS THAN CLASEG INVALID KEY MOVE 1 TO I . LEE-SEGURI-IDX. OPEN I-O SEGURI MOVE ZEROS TO NOEXIS READ SEGURI WITH LOCK KEY IS SEGAUX INVALID KEY MOVE 1 TO NOEXIS . CLOSE SEGURI . GRABA-SEGURI. OPEN I-O SEGURI REWRITE REGSEG INVALID KEY STOP "SEGURIDAD NO FUE ACTUALIZADO" . CLOSE SEGURI . GUARDA-WIN1. call "CBL_READ_SCR_CHATTRS" using datw1 bufw1 atrw1 lonw1 . GUARDA-WIN2. call "CBL_READ_SCR_CHATTRS" using datw2 bufw2 atrw2 lonw2 . PINTA-WIN1. call "CBL_WRITE_SCR_CHATTRS" using datw1 bufw1 atrw1 lonw1 . PINTA-WIN2. call "CBL_WRITE_SCR_CHATTRS" using datw2 bufw2 atrw2 lonw2 . DEFINE-FUNCIONES. * define flechas MOVE 3 TO adis-key-set MOVE 3 TO first-adis MOVE 2 TO number-adis call X"AF" using set-bit-pairs adis-key . MOVE 1 TO adis-key-set MOVE 5 TO first-adis MOVE 2 TO number-adis call X"AF" using set-bit-pairs adis-key . CANCELA-FUNCIONES. MOVE 2 TO adis-key-set MOVE 3 TO first-adis MOVE 2 TO number-adis call X"AF" using set-bit-pairs adis-key . MOVE 2 TO adis-key-set MOVE 5 TO first-adis MOVE 2 TO number-adis call X"AF" using set-bit-pairs adis-key . FIN-PROGRAM. END PROGRAM MENCON.
?
compilando y ejecutando:
Gran curso y lo mas difícil fue el prework de el mismo .El profesor explicó de manera especifica todo y fue muy ameno.
Muchas Gracias Profe Carlos.
Excelente Curso muy bien explicado todo , me encanto poder instalar mi propio maimframe , muchas gracias Carlos
Me encanto este curso Carlos 😃 , la verdad al principio se me dificulto 😦 , pero con la dinámica de enseñanzas la verdad fue fácil de entender . 😃
Agradezco todo tu conocimiento y por tomarte el tiempo de ayudarnos a responder todas las inquietudes . 😃
Muchas gracias.
Se te agradece tus conocimientos, eres muy bueno.
Me encanto este curso, aunque sinceramente no fue nada fácil.
Agradezco al profesor por responder todas las inquietudes que tuve y estoy listo para el curso de cobol practico.
¡Hasta pronto!
aguante platzi!!!
Bueno, en este capitulo si no tengo más preguntas, “Dirás, por fin”, jajajaja, muchísimas gracias Carlos por hacer de este ambiente que es complejo para los nuevos un entorno fácil y amigable, explicando todo a cada detalle y teniendo en cuenta los usos en las distintas terminales 3270, además de tener el tiempo de responder a cada una de las preguntas que se van generando en el curso, mis respetos.
Excelente curso y espero más cursos de usted profesor.
Exelente curso y Exelente profesor, Gracias profe por ayudarnos en cada detalle, error etc, Todos le agradecemos por ayudarnos en todos nuestros errores y dudas, este profe se lleva 5 estrellas!!. Nos vemos en el siguiente curso!
Un excelente curso, Muchas gracias por la información. Conseguí un trabajo, en gran parte por este curso 😊👌👌
Gracias por el curso, estuvo muy bien explicado y a detalle los pasos para realizar la instalación y los programas.
viendo este curso entendí muchas cosas acerca de otros lenguajes de programacion de mas alto nivel en el que ya se da por sentado la declaración de variables y los ciclos, caso que no es el de cobol esto me ayuda a entender como funciona un lenguaje por debajo.
¿Quieres ver más aportes, preguntas y respuestas de la comunidad?