CBL LIB *$SBS * THE ABOVE COBOL DIRECTIVE IS NEEDED FOR MVS ONLY!! * YOU WILL HAVE TO COMMENT IT IF NOT COMPILING IN * THE MVS ENVIRONMENT. *$SBS-END 000010******************************************************* 000020* SAMPLCOB.COB 000030* 000040* THIS PROGRAM DEMONSTRATES THE USE OF THE SILVER 000050* BAY SOFTWARE PDF417 ENCODER AND THE COBOL API. 000060* 000070* THIS PROGRAM IS PORTABLE ACROSS BOTH ASCII AND 000080* EBCDIC MACHINES. 000090* 000100******************************************************* 000150******************************************************* 000160 IDENTIFICATION DIVISION. 000170******************************************************* 000180 PROGRAM-ID. SAMPLCOB. 000190 AUTHOR. SUZETTE CASS 000200 DATE-WRITTEN. 07/09/98. 000220******************************************************* 000230 ENVIRONMENT DIVISION. 000240******************************************************* 000250 CONFIGURATION SECTION. 000270 SOURCE-COMPUTER. IBM-370. 000280 OBJECT-COMPUTER. IBM-370. 000300 INPUT-OUTPUT SECTION. 000320 FILE-CONTROL. 000330 SELECT OUTFILE ASSIGN TO 'TPDFFONT' 000340 FILE STATUS IS FILE-STATUS-OUT. 000360******************************************************* 000370 DATA DIVISION. 000380******************************************************* 000390 FILE SECTION. 000410 FD OUTFILE. 000430 01 OUTRECORD PIC X(50). 000450 WORKING-STORAGE SECTION. 000470 01 WORK-FIELDS. 000480 05 FILE-STATUS-OUT PIC X(2). 000490 05 WS-SUB PIC 99 VALUE ZEROS. 01 INDATA-01. 03 FILLER PIC X(65) VALUE "THIS IS A TEST OF THE SILVER BAY SOFTWARE, LLC. PDF417 ENC - "ODER.". 03 FILLER PIC X(1) VALUE X'0D'. 03 FILLER PIC X(1) VALUE X'0A'. 01 INDATA-02. 03 FILLER PIC X(65) VALUE "THE ERROR CORRECTION WILL ENCODE AT LEVEL 3 WITH ECC PADDI - "NG. ". 03 FILLER PIC X(1) VALUE X'0D'. 03 FILLER PIC X(1) VALUE X'0A'. 01 INDATA-LEN PIC 9(02) VALUE 67. 01 PDF417-INPUT-REC. 05 IN-DATA PIC X(2700) VALUE SPACES. 01 IDX1 PIC 9(4) VALUE ZERO. ******************************************************* * PDF417 COBOL STRUCTURES USED IN API ******************************************************* *$SBS * THE FOLLOWING COPY STATEMENT SHOULD BE UNCOMMENTED * IF COMPILING USING ACUCOBOL OR MICRO FOCUS COBOL. * * COPY "nmpdf417.cob". * * THE FOLLOWING COPY STATEMENT IS REQUIRED FOR THE MVS * ENVIRONMENT. IT WILL NEED TO BE COMMENTED IF NOT * COMPILING IN THE MVS ENVIRONMENT. COPY NMPDF417. *$SBS-END 000980*************************************************************** 000990 PROCEDURE DIVISION. 001000*************************************************************** 001020*************************************************************** 001030* MAIN DRIVER ROUTINE * 001040*************************************************************** 001050 0000-MAIN. 001070 PERFORM 1000-INIT. 001080 PERFORM 2000-PROCESS-DATA. 001090 PERFORM 9000-CLEAN-UP. 001100 STOP RUN. 001120*************************************************************** 001130* THIS SECTION OPENS THE OUTPUT FILE. * 001140*************************************************************** 001150 1000-INIT. 001170 OPEN OUTPUT OUTFILE 001180 IF FILE-STATUS-OUT NOT EQUAL "00" 001190 DISPLAY "UNABLE TO OPEN OUTPUT FILE. FILE STATUS = " FILE-STATUS-OUT *$SBS * UNCOMMENT FOR HITTING RETURN WHEN USING ACUCOBOL ONLY. * ACCEPT OMITTED *$SBS-END 001210 STOP RUN. 001230*************************************************************** 001240* THIS SECTION FORMATS INPUT DATA, CREATES A CALL TO SUB- * 001250* ROUTINES AND CREATES AN OUTPUT FILE WHICH INCLUDES A * 001260* PDF417 SYMBOL AND A RESULT CODE FROM EACH CALL * 001270*************************************************************** 001280 2000-PROCESS-DATA. PERFORM 3000-INIT-INDATA THROUGH 3000-INIT-INDATA-EXIT. 001310 PERFORM 4000-ENCODE-SYMBOL. 2000-PROCESS-DATA-EXIT. EXIT. *************************************************************** * READ THE DATA FROM INPUT FIELDS AND INIT THE PDF417 INPUT * * DATA RECORD FOR ENCODING. * *************************************************************** 3000-INIT-INDATA. MOVE 0 TO IDX1. MOVE INDATA-01 TO IN-DATA(IDX1 + 1 : INDATA-LEN). ADD INDATA-LEN TO IDX1. ADD INDATA-LEN TO NUM-BYTES-TO-ENCODE. MOVE INDATA-02 TO IN-DATA(IDX1 + 1 : INDATA-LEN). ADD INDATA-LEN TO IDX1. ADD INDATA-LEN TO NUM-BYTES-TO-ENCODE. 3000-INIT-INDATA-EXIT. EXIT. 001600*************************************************************** 001610* CALL THE PDF417 ENCODER. * 001620*************************************************************** 001630 4000-ENCODE-SYMBOL. MOVE 0 TO RESULT-CODE. CALL 'PDFENCOD' USING PDF417-PARAMETER-INFO-REC, PDF417-OUTPUT-REC, IN-DATA. 001320 IF PDF-OK PERFORM 5000-PRINT-SYMBOL 001340 ELSE 001350 DISPLAY "ENCODER FAILED. " " ERROR CODE = " RESULT-CODE *$SBS * UNCOMMENT FOR HITTING RETURN WHEN USING ACUCOBOL ONLY. * ACCEPT OMITTED *$SBS-END STOP RUN. 4000-ENCODE-SYMBOL-EXIT. EXIT. 001680*************************************************************** 001690* GENERATE THE OUTPUT: THE 3-90 LINES OF CHARACTERS FROM THE * 001700* ENCODER * 001710*************************************************************** 001720 5000-PRINT-SYMBOL. 001740 MOVE 1 TO WS-SUB. 001750 PERFORM UNTIL WS-SUB > PRINT-SYMBOL-HEIGHT 001770 WRITE OUTRECORD FROM OUTPUT-LINES(WS-SUB) BEFORE ADVANCING 1 LINE 001780 ADD 1 TO WS-SUB 001790 END-PERFORM. 001810*************************************************************** 001820* CLOSE FILES. * 001830*************************************************************** 001840 9000-CLEAN-UP. 001860 CLOSE OUTFILE. 001870 IF FILE-STATUS-OUT NOT EQUAL "00" 001880 DISPLAY "UNABLE TO CLOSE OUTPUT FILE. FILE STATUS = " 001890 FILE-STATUS-OUT *$SBS * UNCOMMENT FOR HITTING RETURN WHEN USING ACUCOBOL ONLY. * ACCEPT OMITTED *$SBS-END 001900 STOP RUN. 001920*************************************************************** 001930* END OF PROGRAM. * 001940***************************************************************