IDENTIFICATION DIVISION. PROGRAM-ID. RECTEST. ***************************************************************** * NAME: RECTEST VERSION: 4.5A DATUM: 01.08.2013 * * FUNKTION: FLAMREC-SCHNITTSTELLE TESTEN. * * MIT DIESEM TESTPROGRAMM KOENNEN ALLE FUNKTIONEN * * DER FLAM SATZSCHNITTSTELLE FLAMREC MIT ALLEN PARA- * * METERWERTEN IN BELIEBIGER REIHENFOLGE AUFGERUFEN * * WERDEN. * * * * FUNCTION: TEST ALL FLAMREC-ENTRIES. * * YOU CAN TEST ALL FUNCTIONS OF THE FLAMREC INTERFACE* * WITH ALL PARAMETERS AND IN ALL SEQUENCE. * ***************************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. * SYSIN IS TERMIN SYSOUT IS TERMOUT. * DATA DIVISION. WORKING-STORAGE SECTION. * * PARAMETER FUER FLMOPN * 77 FLAMID PIC S9(8) COMP SYNC. 01 RETCO PIC S9(8) COMP SYNC. 88 OK VALUE 0. 88 UNZULAESSIG VALUE -1. 01 RETCO-RED REDEFINES RETCO. 05 RETCO-INDICATOR PIC X(1). 88 DVS-ERROR VALUE HIGH-VALUE. 05 SECURE-INDICATOR PIC X(1). 88 FLAM-ERROR VALUE LOW-VALUE. 05 RETCO-FLAM PIC S9(4) COMP SYNC. 88 CUT VALUE 1. 88 EOF VALUE 2. 88 GAP VALUE 3. 88 INVKEY VALUE 5. 77 LASTPAR PIC S9(8) COMP SYNC VALUE 1. 88 LAST-PARAMETER VALUE 0. 77 OPENMODE PIC S9(8) COMP SYNC VALUE 2. 88 OPEN-INPUT VALUE 0. 88 OPEN-OUTPUT VALUE 1. 88 OPEN-INOUT VALUE 2. 88 OPEN-OUTIN VALUE 3. 77 DDNAME PIC X(8) VALUE "FLAMFILE". 77 STATIS PIC S9(8) COMP SYNC VALUE 1. 88 STATISTIK VALUE 1. * * PARAMETER FUER FLMOPD * 77 NAMELEN PIC S9(8) COMP SYNC VALUE 54. 77 FILENAME PIC X(54) VALUE SPACES. 77 DSORG PIC S9(8) COMP SYNC VALUE 1. 77 RECFORM PIC S9(8) COMP SYNC. 77 MAXSIZE PIC S9(8) COMP SYNC VALUE 512. 77 RECDELIM PIC X(4). 77 BLKSIZE PIC S9(8) COMP SYNC. 77 CLOSDISP PIC S9(8) COMP SYNC VALUE 0. 77 DEVICE PIC S9(8) COMP SYNC VALUE 0. * * PARAMETER FUER FLMOPF / FLMOPY * 77 VERSION PIC S9(8) COMP SYNC. 88 VERSION-1 VALUE 100. 88 VERSION-1-1 VALUE 101. 88 VERSION-2 VALUE 200. 77 FLAMCODE PIC S9(8) COMP SYNC. 88 EBC-DIC VALUE 0. 88 ASCII VALUE 1. 77 COMPMODE PIC S9(8) COMP SYNC. 88 CX8 VALUE 0. 88 CX7 VALUE 1. 88 VR8 VALUE 2. 77 MAXBUFF PIC S9(8) COMP SYNC. 77 HEADER PIC S9(8) COMP SYNC VALUE 1. 88 NOHEADER VALUE 0. 88 FILEHEADER VALUE 1. 77 MAXREC PIC S9(8) COMP SYNC VALUE 255. * * SCHLUESSELBESCHREIBUNG DER FLAMFILE * 01 KEYDESC. 05 KEYFLAGS PIC S9(8) COMP SYNC VALUE 1. 05 KEYPARTS PIC S9(8) COMP SYNC VALUE 1. 05 KEYENTRY1. 10 KEYPOS1 PIC S9(8) COMP SYNC VALUE 1. 10 KEYLEN1 PIC S9(8) COMP SYNC VALUE 9. 10 KEYTYPE1 PIC S9(8) COMP SYNC VALUE 1. 05 KEYENTRY-2-BIS-8 OCCURS 7 TIMES. 10 KEYPOS PIC S9(8) COMP SYNC. 10 KEYLEN PIC S9(8) COMP SYNC. 10 KEYTYPE PIC S9(8) COMP SYNC. * 77 BLKMODE PIC S9(8) COMP SYNC. 88 UNBLOCKED VALUE 0. 88 BLOCKED VALUE 1. 77 EXK20 PIC X(8) VALUE SPACES. 77 EXD20 PIC X(8) VALUE SPACES. 77 SECINFO PIC S9(8) COMP SYNC VALUE 0. 77 CRYPTO PIC S9(8) COMP SYNC VALUE 0. * * PARAMETER FUER FLMPHD * 77 NAMELEN-ORIG PIC S9(8) COMP SYNC VALUE 54. 77 FILENAME-ORIG PIC X(54) VALUE SPACES. 77 DSORG-ORIG PIC S9(8) COMP SYNC VALUE 1. 77 RECFORM-ORIG PIC S9(8) COMP SYNC. 77 RECSIZE-ORIG PIC S9(8) COMP SYNC VALUE 512. 77 RECDELIM-ORIG PIC X(4). 77 BLKSIZE-ORIG PIC S9(8) COMP SYNC. 77 PRCTRL-ORIG PIC S9(8) COMP SYNC VALUE 0. 88 NO-CONTROL-CHAR VALUE 0. 88 ASA-CONTROL-CHAR VALUE 1. 88 MACH-CONTROL-CHAR VALUE 2. 77 SYSTEM-ORIG PIC X(2) VALUE LOW-VALUES. 77 LASTPAR-PHD PIC S9(8) COMP SYNC VALUE 1. 88 LAST-PARAMETER-PHD VALUE 0. * * SCHLUESSELBESCHREIBUNG DER ORIGINALDATEI * 01 KEYDESC-ORIG. 05 KEYFLAGS-ORIG PIC S9(8) COMP SYNC VALUE 1. 05 KEYPARTS-ORIG PIC S9(8) COMP SYNC VALUE 1. 05 KEYENTRY1-ORIG. 10 KEYPOS1-ORIG PIC S9(8) COMP SYNC VALUE 1. 10 KEYLEN1-ORIG PIC S9(8) COMP SYNC VALUE 8. 10 KEYTYPE1-ORIG PIC S9(8) COMP SYNC VALUE 1. 05 KEYENTRY-2-BIS-8-ORIG OCCURS 7 TIMES INDEXED BY KEYDESC-INDEX. 10 KEYPOS-ORIG PIC S9(8) COMP SYNC. 10 KEYLEN-ORIG PIC S9(8) COMP SYNC. 10 KEYTYPE-ORIG PIC S9(8) COMP SYNC. * 77 KEYDESC-INDIKATOR PIC X(1) VALUE "Y". 88 KEYDESC-DEFINIERT VALUE "Y". * * PARAMETER FUER FLMPUH * 77 UATTRLEN PIC S9(8) COMP SYNC. 77 USERATTR PIC X(80). * * PARAMETER FLMGET / FLMPUT * 77 RECLEN PIC S9(8) COMP SYNC VALUE 80. 01 REC-ORD. 05 BYTE PIC X(1) OCCURS 32767 TIMES INDEXED BY REC-INDEX. 01 RECORD-DISPLAY REDEFINES REC-ORD PIC X(80). 01 RECORD-KEY-DISPLAY. 02 RECORD-KEY-BYTE PIC X(1) OCCURS 80 INDEXED BY KEY-INDEX. 77 BUFLEN PIC S9(8) COMP SYNC VALUE 32767. * * PARAMETER FLMPWD * 77 PWDLEN PIC S9(8) COMP SYNC VALUE 0. 77 CRYPTOKEY PIC X(64). * * PARAMETER FLMFKY / FLMGRN / FLMFRN * 77 KEY-LEN PIC S9(8) COMP SYNC VALUE 8. 77 CHECKMODE PIC S9(8) COMP SYNC VALUE 0. 77 RECNO PIC S9(8) COMP SYNC. * * PARAMETER FLMSET * 01 FLMSET-RC. 05 FLMSET-RC-RETCO PIC S9(8) COMP. 88 ERR-RC-TIME VALUE 90. 88 ERR-RC-PARAM VALUE 91. 88 ERR-RC-VALUE VALUE 92. 05 FLMSET-RC-INFO PIC 9(8) COMP. 77 FLMSET-PARAM PIC 9(8) COMP. * SET BEFORE FLMOPD 88 SETPRM-SPLITMODE VALUE 1. 88 SETPRM-SPLITNUM VALUE 2. 88 SETPRM-SPLITSIZE VALUE 3. 88 SETPRM-PRIMSPACE VALUE 4. 88 SETPRM-SECSPACE VALUE 5. 88 SETPRM-VOLUME VALUE 6. 88 SETPRM-UNIT VALUE 7. 88 SETPRM-DCLASS VALUE 8. 88 SETPRM-SCLASS VALUE 9. 88 SETPRM-MCLASS VALUE 10. 88 SETPRM-DISPS VALUE 11. 88 SETPRM-DISPN VALUE 12. 88 SETPRM-DISPS VALUE 13. * SET BEFORE FLMOPF 88 SETPRM-CRYPTOMODE VALUE 2001. 88 SETPRM-SECUREINFO VALUE 2002. * 01 FLMSET-VALUE. 05 FLMSET-VALUE-CHAR PIC X(8). 05 FLMSET-VALUE-NUM REDEFINES FLMSET-VALUE-CHAR. 07 FLMSET-VALUE-BIN PIC 9(8) COMP. * 88 SETVAL-SPLITSER VALUE 1. 88 SETVAL-SPLITPAR VALUE 2. 88 SETVAL-CRY-FLAM VALUE 1. 88 SETVAL-CRY-AES VALUE 2. 88 SETVAL-DISP-NEW VALUE 1. 88 SETVAL-DISP-OLD VALUE 2. 88 SETVAL-DISP-SHR VALUE 3. 88 SETVAL-DISP-MOD VALUE 4. 88 SETVAL-DISP-DEL VALUE 1. 88 SETVAL-DISP-KEEP VALUE 2. 88 SETVAL-DISP-CATLG VALUE 3. 88 SETVAL-DISP-UNCAT VALUE 4. * 07 FILLER PIC X(4). * * PARAMETER FOR FLMKME * 77 LKMDATA PIC 9(8) COMP VALUE 79. 77 KMDATA PIC X(79). 77 UNUSED PIC X(4). 77 LXNAM PIC 9(8) COMP VALUE 8. 77 XNAM PIC X(8). 77 LKMPARM PIC 9(8) COMP VALUE 79. 77 KMPARM PIC X(79). 77 LKMMSG PIC 9(8) COMP VALUE 80. 77 KMMSG PIC X(80). * * VARIABLES FOR DISPLAYING THE RETURNCODE * 77 LEN-RETCO PIC S9(8) COMP SYNC VALUE 4. 01 RETCO-HEX. 05 FILLER PIC X(4). 05 RETCO-DISP PIC X(4). * * VARIABLES FOR INPUT AND DISPLAY OF NUMBERS * 01 EINGABE. 05 BYTE-EIN PIC X(1) OCCURS 9 TIMES INDEXED BY EIN-INDEX. 01 INPUT-NUM PIC S9(8). 01 EINGABE-RED REDEFINES INPUT-NUM. 05 BYTE-RED PIC X(1) OCCURS 8 TIMES INDEXED BY RED-INDEX. * * SELECTED FUNCTION * 01 FUNKTION PIC X(8). 88 FLMOPN VALUES "FLMOPN" "OPN". 88 FLMOPD VALUES "FLMOPD" "OPD". 88 FLMOPF VALUES "FLMOPF" "OPF". 88 FLMCLS VALUES "FLMCLS" "CLS". 88 FLMFLU VALUES "FLMFLU" "FLU". 88 FLMEME VALUES "FLMEME" "EME". 88 FLMGET VALUES "FLMGET" "GET". 88 FLMGTR VALUES "FLMGTR" "GTR". 88 FLMGKY VALUES "FLMGKY" "GKY". 88 FLMFKY VALUES "FLMFKY" "FKY". 88 FLMGRN VALUES "FLMGRN" "GRN". 88 FLMFRN VALUES "FLMFRN" "FRN". 88 FLMPUT VALUES "FLMPUT" "PUT". 88 FLMPKY VALUES "FLMPKY" "PKY". 88 FLMIKY VALUES "FLMIKY" "IKY". 88 FLMPOS VALUES "FLMPOS" "POS". 88 FLMDEL VALUES "FLMDEL" "DEL". 88 FLMUPD VALUES "FLMUPD" "UPD". 88 FLMPHD VALUES "FLMPHD" "PHD". 88 FLMPUH VALUES "FLMPUH" "PUH". 88 FLMGHD VALUES "FLMGHD" "GHD". 88 FLMGUH VALUES "FLMGUH" "GUH". 88 FLMPWD VALUES "FLMPWD" "PWD". 88 FLMSET VALUES "FLMSET" "SET". 88 FLMQRY VALUES "FLMQRY" "QRY". 88 FLMKME VALUES "FLMKME" "KME". * * AREAS FOR FLMCLS AND FLMFLU * 77 CPUTIME PIC 9(8) COMP. 77 REC-ORDS PIC 9(8) COMP. 01 BYTEFELD. 05 BYTEOFL PIC 9(8) COMP SYNC. 05 BYTES PIC 9(8) COMP SYNC. 01 BYTECNT REDEFINES BYTEFELD PIC S9(18) COMP SYNC. 77 CMPRECS PIC 9(8) COMP. 01 CMPBYFELD. 05 CMPBYOFL PIC 9(8) COMP SYNC. 05 CMPBYTES PIC 9(8) COMP SYNC. 01 CMPBYCNT REDEFINES CMPBYFELD PIC S9(18) COMP SYNC. * * ZUSAETZLICHE BEREICHE FUER FLMCLF UND FLMEME * 01 SIGNATUR. 05 SIGNAT1 PIC X(4). 05 SIGNAT2 PIC X(4). * 01 SIGNATUR-DIS. 05 SIGNAT1-DIS PIC X(8). 05 SIGNAT2-DIS PIC X(8). * 77 STATIS-DIS PIC ZZZ,ZZZ,ZZZ,ZZZ,ZZZ,ZZ9. * * ARBEITSVARIABLEN * 77 INDEX-DISPLAY PIC 9(8). 77 KEY-IND-DISP PIC S9(8) COMP. 77 GET-COUNT PIC 9(8). 77 GET-INDEX PIC S9(8) COMP SYNC. 77 REL-POSITION PIC S9(8) COMP SYNC. 88 DATEI-ENDE VALUE 99999999. 88 DATEI-ANFANG VALUE -99999999. 77 DIGIT PIC 9. 01 HEXDATA PIC 9(16) COMP SYNC. 01 HEXDATA-BYTES REDEFINES HEXDATA. 05 FILLER PIC X(4). 02 HEXDATA-WORT. 05 BYTE-1-2-HEX PIC X(2). 05 BYTE-3-4-HEX PIC X(2). 77 HEX-QUOTIENT PIC 9(16) COMP SYNC. 77 HEX-REMAINDER PIC 9(16) COMP SYNC. 01 HEXDIGITS PIC X(16) VALUE "0123456789ABCDEF". 01 HEXTAB REDEFINES HEXDIGITS. 05 DIGIT-HEX PIC X(1) OCCURS 16 TIMES INDEXED BY HEX-INDEX. 01 CHARDATA PIC X(8). 01 CHARDATA-BYTES REDEFINES CHARDATA. 05 BYTE-1-CHAR PIC X(2). 05 BYTE-2-4-CHAR. 10 BYTE-2-CHAR PIC X(2). 10 BYTE-3-4-CHAR PIC X(4). 01 CHARDATA-TAB REDEFINES CHARDATA. 05 BYTE-CHAR PIC X(1) OCCURS 8 TIMES INDEXED BY CHAR-INDEX. * PROCEDURE DIVISION. * * DISPLAY START MESSAGE * START-MELDUNG. * DISPLAY " " UPON TERMOUT. DISPLAY "RECTEST STARTED " UPON TERMOUT. DISPLAY " " UPON TERMOUT. * * OPEN FILE * OPEN-EINGABE. * DISPLAY "ENTER PARAMETER FOR FLMOPN:" UPON TERMOUT DISPLAY " " UPON TERMOUT DISPLAY "OPENMODE (0=INPUT 1=OUTPUT 2=INOUT 3=OUTIN) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO OPENMODE DISPLAY "DDNAME ?" UPON TERMOUT ACCEPT DDNAME FROM TERMIN DISPLAY "STATISTICS (0=NO 1=YES) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO STATIS DISPLAY "LASTPAR (0=YES 1=NO) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO LASTPAR * CALL "FLMOPN" USING FLAMID, RETCO, LASTPAR, OPENMODE, DDNAME, STATIS IF NOT OK THEN DISPLAY "ERROR DURING OPEN OF: ", DDNAME UPON TERMOUT PERFORM ERROR-MESSAGE DISPLAY " " UPON TERMOUT DISPLAY "PROGRAM ABNORMAL END" UPON TERMOUT STOP RUN END-IF. * OPEN-NEXT. * IF NOT LAST-PARAMETER THEN DISPLAY "PLEASE SELECT FUNCTION: FLMSET FLMOPD FLMOPF" UPON TERMOUT ACCEPT FUNKTION FROM TERMIN IF FLMSET THEN PERFORM SETPARM-OPD GO TO OPEN-NEXT END-IF IF FLMOPD THEN DISPLAY " " UPON TERMOUT DISPLAY "ENTER PARAMETER FOR FLMOPD:" UPON TERMOUT DISPLAY "FILENAME ?" UPON TERMOUT ACCEPT FILENAME FROM TERMIN DISPLAY "NAMELEN (0 - 54) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO NAMELEN IF OPEN-OUTPUT OR OPEN-OUTIN THEN DISPLAY "DSORG (0=SEQ 1=INDEX ...) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO DSORG DISPLAY "RECFORM (0=VAR 1=FIX ...) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO RECFORM DISPLAY "MAXSIZE (80 - 32768) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO MAXSIZE DISPLAY "KEYDESC FUER ORIGINALDATEI ?" UPON TERMOUT PERFORM KEYDESC-EINGABE MOVE KEYDESC-ORIG TO KEYDESC DISPLAY "BLKSIZE (0 - 32768) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO BLKSIZE ELSE IF OPEN-INOUT THEN DISPLAY "KEYDESC FUER ORIGINALDATEI ?" UPON TERMOUT PERFORM KEYDESC-EINGABE MOVE KEYDESC-ORIG TO KEYDESC END-IF END-IF DISPLAY "CLOSDISP (0=REWIND 1=UNLOAD ...) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO CLOSDISP DISPLAY "DEVICE (0=DISK 1=TAPE ...) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO DEVICE DISPLAY "LASTPAR (0=YES 1=NO) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO LASTPAR CALL "FLMOPD" USING FLAMID, RETCO, LASTPAR, NAMELEN, FILENAME, DSORG, RECFORM, MAXSIZE, RECDELIM, KEYDESC, BLKSIZE, CLOSDISP, DEVICE IF NOT OK THEN DISPLAY "ERROR DURING OPEN OF: ", FILENAME UPON TERMOUT PERFORM ERROR-MESSAGE DISPLAY " " UPON TERMOUT DISPLAY "PROGRAM ABNORMAL END" UPON TERMOUT STOP RUN ELSE DISPLAY "NAMELEN ", NAMELEN UPON TERMOUT DISPLAY "FILENAME ", FILENAME UPON TERMOUT DISPLAY "DSORG ", DSORG UPON TERMOUT DISPLAY "RECFORM ", RECFORM UPON TERMOUT DISPLAY "MAXSIZE ", MAXSIZE UPON TERMOUT IF DSORG > 0 AND KEYPARTS > 0 THEN DISPLAY "KEYDESC DER FLAMFILE" UPON TERMOUT DISPLAY "KEYFLAGS ", KEYFLAGS UPON TERMOUT DISPLAY "KEYPARTS ", KEYPARTS UPON TERMOUT DISPLAY "KEYPOS1 ", KEYPOS1 UPON TERMOUT DISPLAY "KEYLEN1 ", KEYLEN1 UPON TERMOUT DISPLAY "KEYTYPE1 ", KEYTYPE1 UPON TERMOUT END-IF DISPLAY "BLKSIZE ", BLKSIZE UPON TERMOUT DISPLAY "CLOSDISP ", CLOSDISP UPON TERMOUT DISPLAY "DEVICE ", DEVICE UPON TERMOUT END-IF ELSE IF FLMOPF THEN MOVE 1 TO LASTPAR MOVE DDNAME TO FILENAME ELSE DISPLAY FUNKTION, " UNKNOWN" UPON TERMOUT GO TO OPEN-NEXT END-IF END-IF. * OPEN-NEXT-OPF. * IF NOT LAST-PARAMETER THEN DISPLAY "PLEASE SELECT FUNCTION: FLMSET FLMOPF" UPON TERMOUT ACCEPT FUNKTION FROM TERMIN IF FLMSET THEN PERFORM SETPARM-OPF GO TO OPEN-NEXT-OPF END-IF IF FLMOPF THEN DISPLAY " " UPON TERMOUT DISPLAY "ENTER PARAMETER FOR FLMOPF:" UPON TERMOUT IF OPEN-OUTPUT OR OPEN-OUTIN THEN DISPLAY "FLAMCODE (0=EBCDIC 1=ASCII) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO FLAMCODE DISPLAY "COMPMODE (0=CX8 1=CX7 2=VR8 3=ADC)?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO COMPMODE DISPLAY "MAXBUFF (0 - 2621440) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO MAXBUFF DISPLAY "HEADER (0=NO 1=YES) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO HEADER DISPLAY "MAXREC (1 - 4095) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO MAXREC DISPLAY "KEYDESC FUER ORIGINALDATEI ?" UPON TERMOUT PERFORM KEYDESC-EINGABE DISPLAY "BLKMODE (0=UNBLK 1=BLK) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO BLKMODE DISPLAY "EXK20 ?" UPON TERMOUT ACCEPT EXK20 FROM TERMIN IF OPEN-OUTIN THEN DISPLAY "EXD20 ?" UPON TERMOUT ACCEPT EXD20 FROM TERMIN END-IF ELSE DISPLAY "HEADER (0=NO 1=YES) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO HEADER IF OPEN-INOUT THEN DISPLAY "MAXREC (1 - 4095) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO MAXREC DISPLAY "EXK20 ?" UPON TERMOUT ACCEPT EXK20 FROM TERMIN END-IF DISPLAY "KEYDESC FUER ORIGINALDATEI ?" UPON TERMOUT PERFORM KEYDESC-EINGABE DISPLAY "EXD20 ?" UPON TERMOUT ACCEPT EXD20 FROM TERMIN END-IF CALL "FLMOPF" USING FLAMID, RETCO, VERSION, FLAMCODE, COMPMODE, MAXBUFF, HEADER, MAXREC, KEYDESC-ORIG, BLKMODE, EXK20, EXD20 * IF NOT OK THEN DISPLAY "ERROR OPENING FILE: ", FILENAME UPON TERMOUT PERFORM ERROR-MESSAGE DISPLAY " " UPON TERMOUT DISPLAY "PROGRAM ABNORMAL END" UPON TERMOUT STOP RUN ELSE DISPLAY "VERSION ", VERSION UPON TERMOUT DISPLAY "FLAMCODE ", FLAMCODE UPON TERMOUT DISPLAY "COMPMODE ", COMPMODE UPON TERMOUT DISPLAY "MAXBUFF ", MAXBUFF UPON TERMOUT DISPLAY "HEADER ", HEADER UPON TERMOUT DISPLAY "MAXREC ", MAXREC UPON TERMOUT PERFORM KEYDESC-AUSGABE DISPLAY "BLKMODE ", BLKMODE UPON TERMOUT DISPLAY "EXK20 ", EXK20 UPON TERMOUT DISPLAY "EXD20 ", EXD20 UPON TERMOUT END-IF END-IF END-IF. * ***************************************************************** * VERARBEITUNGSSCHLEIFE * ***************************************************************** * PERFORM UNTIL FLMCLS DISPLAY "PLEASE SELECT FUNCTION: " "GET GTR GKY FKY GRN FRN QRY PUT PKY IKY POS DEL" " UPD GHD GUH KME PHD PUH PWD FLU EME CLS" UPON TERMOUT ACCEPT FUNKTION FROM TERMIN IF FLMGET THEN PERFORM SEQUENTIELL-LESEN ELSE IF FLMGTR THEN PERFORM SEQUENTIELL-LESEN-RUECKWAERTS ELSE IF FLMPOS THEN PERFORM POSITIONIEREN ELSE IF FLMDEL THEN PERFORM LOESCHEN ELSE IF FLMGKY THEN PERFORM SCHLUESSEL-LESEN ELSE IF FLMFKY THEN PERFORM SCHLUESSEL-POSITIONIEREN ELSE IF FLMGRN THEN PERFORM SATZNUMMER-LESEN ELSE IF FLMFRN THEN PERFORM SATZNUMMER-POSITIONIEREN ELSE IF FLMPUT THEN PERFORM SCHREIBEN ELSE IF FLMPKY THEN PERFORM SCHLUESSEL-SCHREIBEN ELSE IF FLMUPD THEN PERFORM AENDERN ELSE IF FLMPHD THEN PERFORM HEADER-SCHREIBEN ELSE IF FLMPUH THEN PERFORM USER-HEADER-SCHREIBEN ELSE IF FLMGHD THEN PERFORM HEADER-LESEN ELSE IF FLMGUH THEN PERFORM USER-HEADER-LESEN ELSE IF FLMFLU THEN PERFORM MATRIX-ABSCHLIESSEN ELSE IF FLMIKY THEN PERFORM SCHLUESSEL-EINFUEGEN ELSE IF FLMPWD THEN PERFORM PASSWORD-GEBEN ELSE IF FLMEME THEN PERFORM MEMBER-ABSCHLIESSEN ELSE IF FLMQRY THEN PERFORM QUERY-PARMS ELSE IF FLMKME THEN PERFORM KME-CALL ELSE IF FLMCLS THEN DISPLAY FILENAME, " WILL BE CLOSED" UPON TERMOUT ELSE DISPLAY FUNKTION, " UNBEKANNT" UPON TERMOUT END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-IF END-PERFORM. * FLAMFILE-SCHLIESSEN. * CALL "FLMCLS" USING FLAMID, RETCO CPUTIME REC-ORDS BYTES BYTEOFL CMPRECS CMPBYTES CMPBYOFL IF NOT OK DISPLAY "ERROR CLOSING FLAM (FLMCLS)" UPON TERMOUT PERFORM ERROR-MESSAGE ELSE IF STATISTIK THEN DISPLAY " " UPON TERMOUT MOVE CPUTIME TO STATIS-DIS DISPLAY "CPU-ZEIT ", STATIS-DIS UPON TERMOUT MOVE REC-ORDS TO STATIS-DIS DISPLAY "ORIGINAL RECORDS ", STATIS-DIS UPON TERMOUT MOVE BYTECNT TO STATIS-DIS DISPLAY "ORIGINAL BYTES ", STATIS-DIS UPON TERMOUT MOVE CMPRECS TO STATIS-DIS DISPLAY "COMPRESSED RECORDS ", STATIS-DIS UPON TERMOUT MOVE CMPBYCNT TO STATIS-DIS DISPLAY "COMPRESSED BYTES ", STATIS-DIS UPON TERMOUT END-IF DISPLAY " " UPON TERMOUT DISPLAY "PROGRAM NORMAL END" UPON TERMOUT END-IF. STOP RUN. * ***************************************************************** * VERARBEITUNGSFUNKTIONEN * ***************************************************************** * SEQUENTIELL-LESEN. * DISPLAY "NUMBER RECORDS TO READ ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO GET-COUNT. MOVE 0 TO RETCO. PERFORM VARYING GET-INDEX FROM 0 BY 1 UNTIL GET-INDEX = GET-COUNT OR NOT OK MOVE SPACES TO RECORD-DISPLAY CALL "FLMGET" USING FLAMID, RETCO, RECLEN, REC-ORD, BUFLEN IF GAP DISPLAY "*** GAP FOUND ***" UPON TERMOUT MOVE 0 TO RETCO ELSE IF OK OR CUT DISPLAY RECORD-DISPLAY UPON TERMOUT END-IF END-IF END-PERFORM. IF NOT OK DISPLAY "ERROR IN FLMGET" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. * SEQUENTIELL-LESEN-RUECKWAERTS. * DISPLAY "NUMBER RECORDS TO READ ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO GET-COUNT. MOVE 0 TO RETCO. PERFORM VARYING GET-INDEX FROM 0 BY 1 UNTIL GET-INDEX = GET-COUNT OR NOT OK MOVE SPACES TO RECORD-DISPLAY CALL "FLMGTR" USING FLAMID, RETCO, RECLEN, REC-ORD, BUFLEN IF GAP DISPLAY "*** GAP FOUND ***" UPON TERMOUT MOVE 0 TO RETCO ELSE IF OK OR CUT DISPLAY RECORD-DISPLAY UPON TERMOUT END-IF END-IF END-PERFORM. IF NOT OK DISPLAY "ERROR IN FLMGTR" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. * SATZNUMMER-LESEN. * DISPLAY " " UPON TERMOUT. DISPLAY "RECORD NUMBER ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO RECNO. MOVE SPACES TO RECORD-DISPLAY CALL "FLMGRN" USING FLAMID, RETCO, RECLEN, REC-ORD BUFLEN, RECNO. IF GAP DISPLAY "*** GAP FOUND ***" UPON TERMOUT MOVE 0 TO RETCO ELSE IF OK OR CUT DISPLAY RECORD-DISPLAY UPON TERMOUT END-IF END-IF IF NOT OK DISPLAY "FEHLER BEIM POSITIONIEREN AUF SATZNUMMER" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. * SATZNUMMER-POSITIONIEREN. * DISPLAY " " UPON TERMOUT. DISPLAY "RECORD NUMBER ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO RECNO. DISPLAY "CHECKMODE (0/1/2) ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO CHECKMODE. CALL "FLMFRN" USING FLAMID, RETCO, RECNO, CHECKMODE. IF NOT OK DISPLAY "ERROR IN FLMFRN" UPON TERMOUT PERFORM ERROR-MESSAGE ELSE DISPLAY "RECORD NUMBER: ", RECNO UPON TERMOUT END-IF. * POSITIONIEREN. * DISPLAY " " UPON TERMOUT. DISPLAY "RELATIVE POSITION ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO REL-POSITION. CALL "FLMPOS" USING FLAMID, RETCO, REL-POSITION. IF NOT OK DISPLAY "ERROR IN FLMPOS" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. * LOESCHEN. * CALL "FLMDEL" USING FLAMID, RETCO, IF NOT OK DISPLAY "ERROR IN FLMDEL" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. * SCHLUESSEL-LESEN. * DISPLAY "RECORD KEY ?" UPON TERMOUT. MOVE SPACES TO REC-ORD. ACCEPT RECORD-KEY-DISPLAY FROM TERMIN. SET KEY-INDEX TO 1. SET REC-INDEX TO KEYPOS1-ORIG. PERFORM VARYING KEY-IND-DISP FROM 0 BY 1 UNTIL KEY-IND-DISP = KEYLEN1-ORIG MOVE RECORD-KEY-BYTE(KEY-INDEX) TO BYTE(REC-INDEX) SET KEY-INDEX UP BY 1 SET REC-INDEX UP BY 1 END-PERFORM. PERFORM VARYING KEYDESC-INDEX FROM 1 BY 1 UNTIL KEYDESC-INDEX = KEYPARTS-ORIG SET REC-INDEX TO KEYPOS-ORIG(KEYDESC-INDEX) PERFORM VARYING KEY-IND-DISP FROM 0 BY 1 UNTIL KEY-IND-DISP = KEYLEN-ORIG(KEYDESC-INDEX) MOVE RECORD-KEY-BYTE(KEY-INDEX) TO BYTE(REC-INDEX) SET KEY-INDEX UP BY 1 SET REC-INDEX UP BY 1 END-PERFORM END-PERFORM. CALL "FLMGKY" USING FLAMID, RETCO, RECLEN, REC-ORD, BUFLEN. IF NOT OK THEN DISPLAY "ERROR IN FLMGKY" UPON TERMOUT PERFORM ERROR-MESSAGE MOVE RECORD-KEY-DISPLAY TO RECORD-DISPLAY DISPLAY "SEARCHED RECORD: " UPON TERMOUT DISPLAY RECORD-DISPLAY UPON TERMOUT ELSE DISPLAY RECORD-DISPLAY UPON TERMOUT END-IF. * SCHLUESSEL-POSITIONIEREN. * DISPLAY "KEY LENTGH ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO KEY-LEN. DISPLAY "RECORD KEY ?" UPON TERMOUT. MOVE SPACES TO REC-ORD. ACCEPT RECORD-KEY-DISPLAY FROM TERMIN. DISPLAY "CHECKMODE (0/1/2) ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO CHECKMODE. SET KEY-INDEX TO 1. SET REC-INDEX TO KEYPOS1-ORIG. PERFORM VARYING KEY-IND-DISP FROM 0 BY 1 UNTIL KEY-IND-DISP = KEYLEN1-ORIG MOVE RECORD-KEY-BYTE(KEY-INDEX) TO BYTE(REC-INDEX) SET KEY-INDEX UP BY 1 SET REC-INDEX UP BY 1 END-PERFORM. PERFORM VARYING KEYDESC-INDEX FROM 1 BY 1 UNTIL KEYDESC-INDEX = KEYPARTS-ORIG SET REC-INDEX TO KEYPOS-ORIG(KEYDESC-INDEX) PERFORM VARYING KEY-IND-DISP FROM 0 BY 1 UNTIL KEY-IND-DISP = KEYLEN-ORIG(KEYDESC-INDEX) MOVE RECORD-KEY-BYTE(KEY-INDEX) TO BYTE(REC-INDEX) SET KEY-INDEX UP BY 1 SET REC-INDEX UP BY 1 END-PERFORM END-PERFORM. CALL "FLMFKY" USING FLAMID, RETCO, KEY-LEN, REC-ORD, CHECKMODE. IF NOT OK THEN DISPLAY "ERROR IN FLMKY" UPON TERMOUT PERFORM ERROR-MESSAGE MOVE RECORD-KEY-DISPLAY TO RECORD-DISPLAY DISPLAY "SEARCHED RECORD: " UPON TERMOUT DISPLAY RECORD-DISPLAY UPON TERMOUT END-IF. * SCHREIBEN. * DISPLAY "DATA LENGTH ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO RECLEN. DISPLAY "DATA ?" UPON TERMOUT. MOVE SPACES TO RECORD-DISPLAY ACCEPT RECORD-DISPLAY FROM TERMIN. CALL "FLMPUT" USING FLAMID, RETCO, RECLEN, REC-ORD. IF NOT OK THEN DISPLAY "ERROR IN FLMPUT" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. * SCHLUESSEL-SCHREIBEN. * DISPLAY "DATA LENGTH ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO RECLEN. DISPLAY "DATA WITH KEY ?" UPON TERMOUT. MOVE SPACES TO RECORD-DISPLAY ACCEPT RECORD-DISPLAY FROM TERMIN. CALL "FLMPKY" USING FLAMID, RETCO, RECLEN, REC-ORD. IF NOT OK THEN DISPLAY "ERROR IN FLMPKY" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. * SCHLUESSEL-EINFUEGEN. * DISPLAY "DATA LENGTH ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO RECLEN. DISPLAY "DATA WITH KEY ?" UPON TERMOUT. MOVE SPACES TO RECORD-DISPLAY ACCEPT RECORD-DISPLAY FROM TERMIN. CALL "FLMIKY" USING FLAMID, RETCO, RECLEN, REC-ORD. IF NOT OK THEN DISPLAY "ERROR IN FLMIKY" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. * AENDERN. * DISPLAY "DATA LENGTH ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO RECLEN. DISPLAY "DATA WITH KEY" UPON TERMOUT. MOVE SPACES TO RECORD-DISPLAY ACCEPT RECORD-DISPLAY FROM TERMIN. CALL "FLMUPD" USING FLAMID, RETCO, RECLEN, REC-ORD, BUFLEN. IF NOT OK THEN DISPLAY "ERROR IN FLMUPD" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. * HEADER-SCHREIBEN. * DISPLAY "FILENAME ?" UPON TERMOUT ACCEPT FILENAME-ORIG FROM TERMIN DISPLAY "NAMELEN (0 - 54) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO NAMELEN-ORIG DISPLAY "DSORG (0=SEQ 1=INDEX 2=REL ...) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO DSORG-ORIG DISPLAY "RECFORM (0=VAR 1=FIX 2=UNDEF ...) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO RECFORM-ORIG DISPLAY "RECSIZE (0 - 32768) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO RECSIZE-ORIG DISPLAY "BLKSIZE (0 - 32768) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO BLKSIZE-ORIG IF NOT KEYDESC-DEFINIERT THEN PERFORM KEYDESC-EINGABE MOVE "N" TO KEYDESC-INDIKATOR END-IF DISPLAY "PRCTRL (0=NO 1=MACHINE 2=ASA) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO PRCTRL-ORIG MOVE LOW-VALUES TO SYSTEM-ORIG DISPLAY "LASTPAR (0=YES 1=NO) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO LASTPAR-PHD * CALL "FLMPHD" USING FLAMID, RETCO, NAMELEN-ORIG, FILENAME-ORIG, DSORG-ORIG, RECFORM-ORIG, RECSIZE-ORIG, RECDELIM-ORIG, KEYDESC-ORIG, BLKSIZE-ORIG, PRCTRL-ORIG, SYSTEM-ORIG, LASTPAR-PHD. IF NOT OK THEN DISPLAY "ERROR IN FLMPHD" UPON TERMOUT PERFORM ERROR-MESSAGE ELSE IF NOT LAST-PARAMETER-PHD THEN DISPLAY " " UPON TERMOUT DISPLAY "WRITE USER HEADER" UPON TERMOUT PERFORM USER-HEADER-SCHREIBEN END-IF END-IF. * USER-HEADER-SCHREIBEN. * DISPLAY "LENGTH OF USER HEADER ?" UPON TERMOUT PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO UATTRLEN. DISPLAY "USER SPECIFIED DATA ?" UPON TERMOUT ACCEPT USERATTR FROM TERMIN CALL "FLMPUH" USING FLAMID, RETCO, UATTRLEN, USERATTR. IF NOT OK THEN DISPLAY "ERROR IN FLMPUH" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. * HEADER-LESEN. * MOVE 54 TO NAMELEN-ORIG. MOVE SPACES TO FILENAME-ORIG. CALL "FLMGHD" USING FLAMID, RETCO, NAMELEN-ORIG, FILENAME-ORIG, DSORG-ORIG, RECFORM-ORIG, RECSIZE-ORIG, RECDELIM-ORIG, KEYDESC-ORIG, BLKSIZE-ORIG, PRCTRL-ORIG, SYSTEM-ORIG. IF NOT OK THEN DISPLAY "ERROR IN FLMGHD" UPON TERMOUT PERFORM ERROR-MESSAGE ELSE DISPLAY "NAMELEN ", NAMELEN-ORIG UPON TERMOUT DISPLAY "FILENAME ", FILENAME-ORIG UPON TERMOUT DISPLAY "DSORG ", DSORG-ORIG UPON TERMOUT DISPLAY "RECFORM ", RECFORM-ORIG UPON TERMOUT DISPLAY "RECSIZE ", RECSIZE-ORIG UPON TERMOUT PERFORM KEYDESC-AUSGABE DISPLAY "BLKSIZE ", BLKSIZE-ORIG UPON TERMOUT DISPLAY "PRCTRL ", PRCTRL-ORIG UPON TERMOUT DISPLAY "RECSIZE ", RECSIZE-ORIG UPON TERMOUT MOVE SYSTEM-ORIG TO BYTE-3-4-HEX PERFORM HEX-TO-CHAR DISPLAY "SYSTEM ", BYTE-3-4-CHAR UPON TERMOUT END-IF. * USER-HEADER-LESEN. * MOVE 80 TO UATTRLEN. MOVE SPACES TO USERATTR. CALL "FLMGUH" USING FLAMID, RETCO, UATTRLEN, USERATTR. IF NOT OK THEN DISPLAY "ERROR IN FLMGUH" UPON TERMOUT PERFORM ERROR-MESSAGE ELSE DISPLAY "UATTRLEN ", UATTRLEN UPON TERMOUT IF UATTRLEN > 0 THEN DISPLAY USERATTR UPON TERMOUT END-IF END-IF. * MATRIX-ABSCHLIESSEN. * CALL "FLMFLU" USING FLAMID, RETCO CPUTIME REC-ORDS BYTES BYTEOFL CMPRECS CMPBYTES CMPBYOFL. IF NOT OK DISPLAY "ERROR IN FLMFLU" UPON TERMOUT PERFORM ERROR-MESSAGE ELSE IF STATISTIK THEN DISPLAY " " UPON TERMOUT MOVE CPUTIME TO STATIS-DIS DISPLAY "CPU-ZEIT ", STATIS-DIS UPON TERMOUT MOVE REC-ORDS TO STATIS-DIS DISPLAY "ORIGINAL RECORDS ", STATIS-DIS UPON TERMOUT MOVE BYTECNT TO STATIS-DIS DISPLAY "ORIGINAL BYTES ", STATIS-DIS UPON TERMOUT MOVE CMPRECS TO STATIS-DIS DISPLAY "COMP. RECORDS ", STATIS-DIS UPON TERMOUT MOVE CMPBYCNT TO STATIS-DIS DISPLAY "COMP. BYTES ", STATIS-DIS UPON TERMOUT END-IF END-IF. * MEMBER-ABSCHLIESSEN. * CALL "FLMEME" USING FLAMID, RETCO CPUTIME REC-ORDS BYTES BYTEOFL CMPRECS CMPBYTES CMPBYOFL SIGNATUR. IF NOT OK DISPLAY "ERROR IN FLMEME" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. DISPLAY " " UPON TERMOUT MOVE CPUTIME TO STATIS-DIS DISPLAY "CPU-ZEIT ", STATIS-DIS UPON TERMOUT MOVE REC-ORDS TO STATIS-DIS DISPLAY "ORIGINAL RECORDS ", STATIS-DIS UPON TERMOUT MOVE BYTECNT TO STATIS-DIS DISPLAY "ORIGINAL BYTES ", STATIS-DIS UPON TERMOUT MOVE CMPRECS TO STATIS-DIS DISPLAY "COMP. RECORDS ", STATIS-DIS UPON TERMOUT MOVE CMPBYCNT TO STATIS-DIS DISPLAY "COMP. BYTES ", STATIS-DIS UPON TERMOUT MOVE ZERO TO HEXDATA MOVE SIGNAT1 TO HEXDATA-WORT PERFORM HEX-TO-CHAR MOVE CHARDATA TO SIGNAT1-DIS MOVE ZERO TO HEXDATA MOVE SIGNAT2 TO HEXDATA-WORT PERFORM HEX-TO-CHAR MOVE CHARDATA TO SIGNAT2-DIS DISPLAY "SIGNATURE ", SIGNATUR-DIS UPON TERMOUT. * PASSWORD-GEBEN. * DISPLAY "PASSWORD LENGTH ?" UPON TERMOUT. PERFORM NUMERIC-INPUT. MOVE INPUT-NUM TO PWDLEN DISPLAY "PASSWORD ?" UPON TERMOUT. MOVE SPACES TO CRYPTOKEY ACCEPT CRYPTOKEY FROM TERMIN. CALL "FLMPWD" USING FLAMID, RETCO, PWDLEN, CRYPTOKEY. IF NOT OK THEN DISPLAY "ERROR IN FLMPWD" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF. * SETPARM-OPD. * DISPLAY "ENTER PARAMETER:" UPON TERMOUT DISPLAY " 1 = SPLITMODE, 2 = SPLITSIZE, 3 = SPLITNUMBER" UPON TERMOUT DISPLAY " 4 = PRIM. SPACE, 5 = SECOND. SPACE" UPON TERMOUT DISPLAY " 6 = VOLUME, 7 = UNIT" UPON TERMOUT DISPLAY " 8 = DATA CLASS, 9 = STORAGE CLASS, 10 = MGT CLASS" UPON TERMOUT DISPLAY "11 = DISP STATUS, 12 = DISP NORMAL, 13 = DISP ANORM" UPON TERMOUT DISPLAY "2001 = CRYPTOMODE, 2002 = SECUREINFO" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO FLMSET-PARAM DISPLAY "ENTER VALUE:" IF FLMSET-PARAM < 6 OR FLMSET-PARAM > 10 THEN PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO FLMSET-VALUE-BIN ELSE ACCEPT FLMSET-VALUE-CHAR END-IF * CALL "FLMSET" USING FLAMID, FLMSET-RC, FLMSET-PARAM, FLMSET-VALUE DISPLAY "RETURNCODE, INFOCODE:" UPON TERMOUT DISPLAY FLMSET-RC-RETCO ", " FLMSET-RC-INFO UPON TERMOUT. * SETPARM-OPF. * DISPLAY "ENTER PARAMETER:" UPON TERMOUT DISPLAY "2001 = CRYPTOMODE, 2002 = SECUREINFO" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO FLMSET-PARAM DISPLAY "ENTER VALUE (0/1/2/3)" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO FLMSET-VALUE-BIN * CALL "FLMSET" USING FLAMID, FLMSET-RC, FLMSET-PARAM, FLMSET-VALUE DISPLAY "RETURNCODE, INFOCODE:" UPON TERMOUT DISPLAY FLMSET-RC-RETCO ", " FLMSET-RC-INFO UPON TERMOUT. * QUERY-PARMS. * DISPLAY "ENTER PARAMETER:" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO FLMSET-PARAM CALL "FLMQRY" USING FLAMID, FLMSET-RC, FLMSET-PARAM, FLMSET-VALUE DISPLAY "RETURNCODE, INFOCODE:" UPON TERMOUT DISPLAY FLMSET-RC-RETCO ", " FLMSET-RC-INFO UPON TERMOUT * IF FLMSET-PARAM < 6 OR FLMSET-PARAM > 10 THEN DISPLAY "VALUE: " FLMSET-VALUE-BIN UPON TERMOUT ELSE DISPLAY "VALUE: " FLMSET-VALUE-CHAR UPON TERMOUT END-IF. * KME-CALL. * DISPLAY "KME-MODULE NAME?" UPON TERMOUT ACCEPT XNAM FROM TERMIN DISPLAY "PARAMETER FOR THIS MODULE?" UPON TERMOUT ACCEPT KMPARM FROM TERMIN DISPLAY "PARAMETER LENGTH (1-79)?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO LKMDATA DISPLAY "DATA FOR THE EXIT MODULE?" UPON TERMOUT ACCEPT KMDATA FROM TERMIN DISPLAY "DATA LENGTH (1-79)?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO LKMDATA CALL "FLMKME" USING FLAMID, RETCO, LKMDATA, KMDATA, UNUSED, UNUSED, LXNAM, XNAM, LKMPARM, KMPARM, LKMMSG, KMMSG. IF NOT OK THEN DISPLAY "ERROR IN FLMKME" UPON TERMOUT PERFORM ERROR-MESSAGE END-IF DISPLAY "MODULE-MESSAGE:" UPON TERMOUT DISPLAY KMMSG UPON TERMOUT DISPLAY "DATA RETURNED FROM THE MODULE" UPON TERMOUT DISPLAY KMDATA UPON TERMOUT. ***************************************************************** * HILFSFUNKTIONEN / HELP FUNCTIONS * ***************************************************************** * ERROR-MESSAGE. * IF UNZULAESSIG THEN DISPLAY "ILLEGAL FUNCTION" UPON TERMOUT ELSE IF DVS-ERROR THEN * MOVE LOW-VALUE TO RETCO-INDICATOR MOVE ZERO TO HEXDATA MOVE RETCO-RED TO HEXDATA-WORT PERFORM HEX-TO-CHAR DISPLAY "DMS-ERRORCODE: ", BYTE-2-4-CHAR UPON TERMOUT ELSE IF FLAM-ERROR THEN DISPLAY "FLAM-RETURNCODE: ", RETCO-FLAM UPON TERMOUT ELSE * MOVE LOW-VALUE TO RETCO-INDICATOR MOVE ZERO TO HEXDATA MOVE RETCO-RED TO HEXDATA-WORT PERFORM HEX-TO-CHAR DISPLAY "SECINFO-CODE: ", BYTE-2-4-CHAR UPON TERMOUT END-IF END-IF END-IF. * NUMERIC-INPUT. * ACCEPT EINGABE FROM TERMIN. MOVE 0 TO INPUT-NUM. SET RED-INDEX TO 8. PERFORM VARYING EIN-INDEX FROM 9 BY -1 UNTIL EIN-INDEX = 0 OR RED-INDEX = 0 IF BYTE-EIN(EIN-INDEX) NUMERIC THEN MOVE BYTE-EIN(EIN-INDEX) TO BYTE-RED(RED-INDEX) SET RED-INDEX DOWN BY 1 END-IF END-PERFORM. IF BYTE-EIN(1) = "-" THEN COMPUTE INPUT-NUM = -1 * INPUT-NUM END-IF. * HEX-TO-CHAR. * PERFORM VARYING CHAR-INDEX FROM 8 BY -1 UNTIL CHAR-INDEX = 1 DIVIDE HEXDATA BY 16 GIVING HEX-QUOTIENT REMAINDER HEX-REMAINDER END-DIVIDE ADD 1 TO HEX-REMAINDER SET HEX-INDEX TO HEX-REMAINDER MOVE HEX-QUOTIENT TO HEXDATA MOVE DIGIT-HEX(HEX-INDEX) TO BYTE-CHAR(CHAR-INDEX) END-PERFORM. * KEYDESC-EINGABE. * DISPLAY "KEYPARTS (0 - 8) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO KEYPARTS-ORIG IF KEYPARTS-ORIG > 0 THEN DISPLAY "KEYFLAGS (0=NODUP 1=DUPKY) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO KEYFLAGS-ORIG DISPLAY "KEYPOS1 (1 - 32767) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO KEYPOS1-ORIG DISPLAY "KEYLEN1 (1 - 255) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO KEYLEN1-ORIG DISPLAY "KEYTYPE1 (0=DISP 1=BINARY) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO KEYTYPE1-ORIG PERFORM VARYING KEYDESC-INDEX FROM 1 BY 1 UNTIL KEYDESC-INDEX = KEYPARTS-ORIG SET DIGIT TO KEYDESC-INDEX ADD 1 TO DIGIT DISPLAY "KEYPOS", DIGIT, " (1 - 32767) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO KEYPOS-ORIG(KEYDESC-INDEX) DISPLAY "KEYLEN", DIGIT, " (1 - 255) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO KEYLEN-ORIG(KEYDESC-INDEX) DISPLAY "KEYTYPE", DIGIT, " (0=DISP 1=BIN) ?" UPON TERMOUT PERFORM NUMERIC-INPUT MOVE INPUT-NUM TO KEYTYPE-ORIG(KEYDESC-INDEX) END-PERFORM END-IF. * KEYDESC-AUSGABE. * IF KEYPARTS-ORIG > 0 THEN DISPLAY "KEYDESC DER ORIGINALDATEI" UPON TERMOUT DISPLAY "KEYPARTS ", KEYPARTS-ORIG UPON TERMOUT DISPLAY "KEYFLAGS ", KEYFLAGS-ORIG UPON TERMOUT DISPLAY "KEYPOS1 ", KEYPOS1-ORIG UPON TERMOUT DISPLAY "KEYLEN1 ", KEYLEN1-ORIG UPON TERMOUT DISPLAY "KEYTYPE1 ", KEYTYPE1-ORIG UPON TERMOUT PERFORM VARYING KEYDESC-INDEX FROM 1 BY 1 UNTIL KEYDESC-INDEX = KEYPARTS-ORIG SET DIGIT TO KEYDESC-INDEX ADD 1 TO DIGIT DISPLAY "KEYPOS", DIGIT, " ", KEYPOS-ORIG(KEYDESC-INDEX) UPON TERMOUT DISPLAY "KEYLEN", DIGIT, " ", KEYLEN-ORIG(KEYDESC-INDEX) UPON TERMOUT DISPLAY "KEYTYPE", DIGIT, " ", KEYTYPE-ORIG(KEYDESC-INDEX) UPON TERMOUT END-PERFORM END-IF.