home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / viscobv6.zip / vac22os2 / ibmcobol / samples / sdu / iwzzsux.cbl < prev    next >
Text File  |  1997-03-14  |  7KB  |  140 lines
  1.       **********************************************************
  2.       *  PRODUCT   = Data Description and Conversion for OS/2
  3.       *
  4.       *  SOURCE FILE NAME = IWZZSUX.CBL
  5.       *
  6.       *  DESCRIPTIVE NAME = User Exit Sample
  7.       *
  8.       *  FUNCTION = This user exit sample program can be called via the
  9.       *              DDC/2 user exit facility.
  10.       *              It converts any character string from upper case   
  11.       *              to lower case characters or from lower case to
  12.       *              upper case characters, depending on a boolean
  13.       *              parameter.
  14.       *
  15.       *  ENTRY POINT = ConvertToUpperLowerCaseChar
  16.       *
  17.       **********************************************************
  18.         IDENTIFICATION DIVISION.
  19.         PROGRAM-ID. ConvertToUpperLowerCaseChar.
  20.         ENVIRONMENT DIVISION.
  21.         CONFIGURATION SECTION.
  22.         SOURCE-COMPUTER. IBM-PS2.
  23.         OBJECT-COMPUTER. IBM-PS2.
  24.         DATA DIVISION.
  25.         WORKING-STORAGE SECTION.
  26.       **********************************************************
  27.       *  Conversion tables and local variables
  28.       **********************************************************
  29.         01  UpperCase VALUE IS "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
  30.             05 UpperChar PICTURE X(1) OCCURS 26 TIMES
  31.                          INDEXED BY J. 
  32.         01  LowerCase  VALUE IS "abcdefghijklmnopqrstuvwxyz".
  33.             05 LowerChar PICTURE X(1) OCCURS 26 TIMES
  34.                          INDEXED BY L.
  35.         77  Switch  PICTURE 9(6) USAGE IS BINARY.
  36.         77  ADLTrue  PICTURE X(1) VALUE IS X"01".
  37.         LINKAGE SECTION.
  38.       **********************************************************
  39.       *  Expected parameters:
  40.       *     ParamCount:      5
  41.       *     ParameterPtr(1)  Reference to the input character field.
  42.       *     ParameterPtr(2)  Reference to the length of the input
  43.       *                      character field.
  44.       *     ParameterPtr(3)  Reference to a boolean condition.
  45.       *     ParameterPtr(4)  Reference to output character field.
  46.       *     ParameterPtr(5)  Reference to the length of output
  47.       *                      character field.
  48.       *     ParameterPtr(6)  Reference to feedback area
  49.       *                      (NO ERROR: MsgSev = 0).
  50.       **********************************************************
  51.         77  ParamCount  PICTURE 9(6) USAGE IS BINARY.
  52.         01  ParameterList.
  53.             05  ParameterPtr  USAGE IS POINTER OCCURS 5 TIMES.
  54.         01  FeedBack.
  55.             05 Condition-ID.
  56.                 10 MsgSev  PICTURE 9(2) USAGE IS BINARY.
  57.                 10 MsgNo    PICTURE 9(2) USAGE IS BINARY.
  58.             05 Case-Severity-Control  PICTURE X.
  59.             05 Facility-ID  PICTURE X(3).
  60.             05 I-S-Info.
  61.                 10 AdlExId  PICTURE 9(6) USAGE IS BINARY.
  62.                 10 AdlCommAreaPtr REDEFINES AdlExId USAGE IS POINTER.
  63.                 10 User-ExitCtokPtr  REDEFINES AdlExId USAGE IS POINTER.
  64.         01  InputCharField.
  65.             05 InputChar PICTURE X(1) OCCURS 1 TO 256 TIMES
  66.                          DEPENDING ON ByteSizeOfInputChar
  67.                          INDEXED BY I.
  68.         77  ByteSizeOfInputChar  PICTURE 9(6) USAGE IS BINARY.
  69.         77  ToUpperCaseLetter PICTURE X(1).
  70.         01  OutputCharField.
  71.             05 OutputChar PICTURE X(1) OCCURS 1 TO 256 TIMES
  72.                          DEPENDING ON ByteSizeOfOutputChar
  73.                          INDEXED BY K.
  74.         77  ByteSizeOfOutputChar  PICTURE 9(6) USAGE IS BINARY.
  75.         PROCEDURE DIVISION USING BY VALUE ParamCount
  76.                                  BY REFERENCE ParameterList
  77.                                  BY REFERENCE FeedBack.
  78.       **********************************************************
  79.       *  Initialization of variables
  80.       **********************************************************
  81.             SET ADDRESS OF InputCharField TO ParameterPtr(1).
  82.             SET ADDRESS OF ByteSizeOfInputChar TO ParameterPtr(2).
  83.             SET ADDRESS OF ToUpperCaseLetter TO ParameterPtr(3).
  84.             SET ADDRESS OF OutputCharField TO ParameterPtr(4).
  85.             SET ADDRESS OF ByteSizeOfOutputChar TO ParameterPtr(5).
  86.             MOVE 0 TO MsgSev OF Condition-ID IN FeedBack.
  87.             MOVE 0 TO MsgNo OF Condition-ID IN FeedBack.
  88.       **********************************************************
  89.       *  Check buffer sizes and parameter count
  90.       **********************************************************
  91.             IF ByteSizeOfInputChar <= ByteSizeOfOutputChar AND
  92.                ParamCount = 5
  93.             THEN
  94.                IF ToUpperCaseLetter = ADLTrue
  95.                THEN
  96.       **********************************************************
  97.       *  Convert all lower case characters to upper case characters
  98.       **********************************************************
  99.                   PERFORM ToUpper VARYING I FROM 1 BY 1
  100.                                   UNTIL I > ByteSizeOfInputChar
  101.                ELSE
  102.       **********************************************************
  103.       *  Convert all upper case characters to lower case characters
  104.       **********************************************************
  105.                   PERFORM ToLower VARYING I FROM 1 BY 1
  106.                                   UNTIL I > ByteSizeOfInputChar
  107.             ELSE
  108.       **********************************************************
  109.       *  Set error conditions
  110.       **********************************************************
  111.                MOVE 3 TO MsgSev OF Condition-ID IN FeedBack
  112.                MOVE 2647 TO MsgNo OF Condition-ID IN FeedBack
  113.             END-IF.
  114.             EXIT PROGRAM.
  115.         ToUpper.
  116.             MOVE 0 TO Switch.
  117.             SET K TO I.
  118.             MOVE Inputchar(I) TO OutputChar(K).
  119.             PERFORM VARYING J FROM 1 BY 1
  120.                     UNTIL J > 26 OR Switch = 1
  121.                IF InputChar(I) = LowerChar(J)
  122.                THEN
  123.                   MOVE UpperChar(J) TO OutputChar(K)
  124.                   MOVE 1 TO Switch
  125.                END-IF                                                                                                           
  126.             END-PERFORM.
  127.         ToLower.
  128.             MOVE 0 TO Switch.
  129.             SET K TO I.
  130.             MOVE Inputchar(I) TO OutputChar(K).
  131.             PERFORM VARYING L FROM 1 BY 1
  132.                     UNTIL L > 26 OR Switch = 1
  133.                IF InputChar(I) = UpperChar(L)
  134.                THEN
  135.                   MOVE LowerChar(L) TO OutputChar(I)
  136.                   MOVE 1 TO Switch
  137.                END-IF
  138.             END-PERFORM.
  139.         END PROGRAM  ConvertToUpperLowerCaseChar.
  140.