midrange.com code scratchpad
Name:
BASE
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
07/29/2010 01:12:52 am
IP:
Logged
Description:
Base64/32/16 conversion routines. The Base16 routines weren't written in this version - that's an exercise for the reader...
Code:
  1. BASE_P copybook
  2.  
  3.       /IF DEFINED(BASE_P)
  4.       /EOF
  5.       /ENDIF
  6.       /DEFINE BASE_P
  7.  
  8.      D base64_encode   pr            10u 0 extproc('base64_encode')
  9.      D   plainptr                      *   value
  10.      D   plainlen                    10u 0 value
  11.      D   base64ptr                     *   value
  12.      D   base64size                  10u 0 value
  13.  
  14.      D base64_decode   pr            10U 0 extproc('base64_decode')
  15.      D   base64ptr                     *   value
  16.      D   base64len                   10u 0 value
  17.      D   plainptr                      *   value
  18.      D   plainsize                   10u 0 value
  19.  
  20.      D base64_encode_len...
  21.      D                 pr            10u 0 extproc('base64_encode_len')
  22.      D   plainlen                    10u 0 value
  23.  
  24.      D base64_decode_len...
  25.      D                 pr            10u 0 extproc('base64_decode_len')
  26.      D   base64ptr                     *   value
  27.      D   base64len                   10u 0 value
  28.  
  29.      D base32_encode   pr            10u 0 extproc('base32_encode')
  30.      D   plainptr                      *   value
  31.      D   plainlen                    10u 0 value
  32.      D   base32ptr                     *   value
  33.      D   base32size                  10u 0 value
  34.  
  35.      D base32_decode   pr            10U 0 extproc('base32_decode')
  36.      D   base32ptr                     *   value
  37.      D   base32len                   10u 0 value
  38.      D   plainptr                      *   value
  39.      D   plainsize                   10u 0 value
  40.  
  41.      D base32_encode_len...
  42.      D                 pr            10u 0 extproc('base32_encode_len')
  43.      D   plainlen                    10u 0 value
  44.  
  45.      D base32_decode_len...
  46.      D                 pr            10u 0 extproc('base32_decode_len')
  47.      D   base32ptr                     *   value
  48.      D   base32len                   10u 0 value
  49.  
  50.      D base16_encode   pr            10u 0 extproc('base16_encode')
  51.      D   plainptr                      *   value
  52.      D   plainlen                    10u 0 value
  53.      D   base16ptr                     *   value
  54.      D   base16size                  10u 0 value
  55.  
  56.      D base16_decode   pr            10U 0 extproc('base16_decode')
  57.      D   base16ptr                     *   value
  58.      D   base16len                   10u 0 value
  59.      D   plainptr                      *   value
  60.      D   plainsize                   10u 0 value
  61.  
  62.      D base16_encode_len...
  63.      D                 pr            10u 0 extproc('base16_encode_len')
  64.      D   plainlen                    10u 0 value
  65.  
  66.      D base16_decode_len...
  67.      D                 pr            10u 0 extproc('base16_decode_len')
  68.      D   base16ptr                     *   value
  69.      D   base16len                   10u 0 value
  70.  
  71. BASE member
  72.  
  73.      H NOMAIN
  74.       *T: Base64/32/16 encoding functions
  75.       *=============================================================================================
  76.  
  77.       /copy qrpglesrc,base_p                     ‚Base64/32/16 encoding functions
  78.  
  79.      D bitform         PR           512A   Extproc('bitform')
  80.      D   string                      32A   Const
  81.      D   stringlen                   10I 0 Const
  82.  
  83.      D charform        PR            32A   Extproc('charform')
  84.      D   string                     512A   Value
  85.      D   stringlen                   10I 0 Value
  86.  
  87.      D Base64Str       S                   Like(BaseArr)
  88.      D                                     Inz('000000A000001B000010C000011D+
  89.      D                                          000100E000101F000110G000111H+
  90.      D                                          001000I001001J001010K001011L+
  91.      D                                          001100M001101N001110O001111P+
  92.      D                                          010000Q010001R010010S010011T+
  93.      D                                          010100U010101V010110W010111X+
  94.      D                                          011000Y011001Z011010a011011b+
  95.      D                                          011100c011101d011110e011111f+
  96.      D                                          100000g100001h100010i100011j+
  97.      D                                          100100k100101l100110m100111n+
  98.      D                                          101000o101001p101010q101011r+
  99.      D                                          101100s101101t101110u101111v+
  100.      D                                          110000w110001x110010y110011z+
  101.      D                                          1101000110101111011021101113+
  102.      D                                          1110004111001511101061110117+
  103.      D                                          11110081111019111110+111111/')
  104.      D Base64StrPtr    S               *   Inz(%addr(Base64Str))
  105.  
  106.      D Base32Str       S                   Like(BaseArr)
  107.      D                                     Inz('00000 A+
  108.      D                                          00001 B+
  109.      D                                          00010 C+
  110.      D                                          00011 D+
  111.      D                                          00100 E+
  112.      D                                          00101 F+
  113.      D                                          00110 G+
  114.      D                                          00111 H+
  115.      D                                          01000 I+
  116.      D                                          01001 J+
  117.      D                                          01010 K+
  118.      D                                          01011 L+
  119.      D                                          01100 M+
  120.      D                                          01101 N+
  121.      D                                          01110 O+
  122.      D                                          01111 P+
  123.      D                                          10000 Q+
  124.      D                                          10001 R+
  125.      D                                          10010 S+
  126.      D                                          10011 T+
  127.      D                                          10100 U+
  128.      D                                          10101 V+
  129.      D                                          10110 W+
  130.      D                                          10111 X+
  131.      D                                          11000 Y+
  132.      D                                          11001 Z+
  133.      D                                          11010 2+
  134.      D                                          11011 3+
  135.      D                                          11100 4+
  136.      D                                          11101 5+
  137.      D                                          11110 6+
  138.      D                                          11111 7')
  139.      D Base32StrPtr    S               *   Inz(%addr(Base32Str))
  140.  
  141.      D Base16Str       S                   Like(BaseArr)
  142.      D                                     Inz('0000  0+
  143.      D                                          0000  1+
  144.      D                                          0001  2+
  145.      D                                          0001  3+
  146.      D                                          0010  4+
  147.      D                                          0010  5+
  148.      D                                          0011  6+
  149.      D                                          0011  7+
  150.      D                                          0100  8+
  151.      D                                          0100  9+
  152.      D                                          0101  A+
  153.      D                                          0101  B+
  154.      D                                          0110  C+
  155.      D                                          0110  D+
  156.      D                                          0111  E+
  157.      D                                          0111  F')
  158.      D Base16StrPtr    S               *   Inz(%addr(Base16Str))
  159.  
  160.      D BaseArr         DS                  Based(BaseArrPtr)
  161.      D  Elm                                Dim(64)
  162.      D   Hex                               Overlay(Elm)
  163.      D     Hex6                       6A   Overlay(Hex)
  164.      D     Hex5                       5A   Overlay(Hex)
  165.      D     Hex4                       4A   Overlay(Hex)
  166.      D   Char                         1A   Overlay(Elm:*Next)
  167.  
  168.       *=============================================================================================
  169.       *‚base64_encode(): Encode plain text string into Base64
  170.       *
  171.       *‚Returns the length of the resulting encoded string or a negative
  172.       *‚number denoting the position of the error within the string
  173.       *=============================================================================================
  174.      P base64_encode   B                   export
  175.      D                 PI            10U 0
  176.      D   plainptr                      *   value
  177.      D   plainlen                    10U 0 value
  178.      D   base64ptr                     *   value
  179.      D   base64size                  10U 0 value
  180.       *---------------------------------------------------------------------------------------------
  181.      D plainstr        S              3A   Based(plainptr)
  182.  
  183.      D base64bit       DS
  184.      D   b64b1                        6A
  185.      D   b64b2                        6A
  186.      D   b64b3                        6A
  187.      D   b64b4                        6A
  188.  
  189.      D base64str       S              4A   based(base64ptr)
  190.      D base64len       S             10I 0 inz
  191.      D pos             S             10I 0 inz
  192.      D len             S             10I 0 inz
  193.       *---------------------------------------------------------------------------------------------
  194.       /free
  195.  
  196.         BaseArrPtr = Base64StrPtr;
  197.  
  198.         //‚Not enough space to encode string, so truncate
  199.         if base64_encode_len( plainlen ) > base64size;
  200.           plainlen = %int( base64size / 4 ) * 3;
  201.         endif;
  202.  
  203.         if plainlen > 2;
  204.           dow pos <= ( plainlen - 3 );
  205.             base64bit = bitform( plainstr : 3 );
  206.             base64str = Char( %lookup( b64b1 : Hex6 : 1 : 64 ) ) +
  207.                         Char( %lookup( b64b2 : Hex6 : 1 : 64 ) ) +
  208.                         Char( %lookup( b64b3 : Hex6 : 1 : 64 ) ) +
  209.                         Char( %lookup( b64b4 : Hex6 : 1 : 64 ) );
  210.             base64ptr = base64ptr + 4;
  211.             base64len = base64len + 4;
  212.             plainptr = plainptr + 3;
  213.             pos = pos + 3;
  214.           enddo;
  215.         endif;
  216.         if plainlen > pos;
  217.           len = plainlen - pos;
  218.           base64bit = bitform( plainstr : len );
  219.           %subst( base64bit : ( len * 8 ) + 1 ) = *all'0';
  220.           select;
  221.             when len = 2;
  222.               base64str = Char( %lookup( b64b1 : Hex6 : 1 : 64 ) ) +
  223.                           Char( %lookup( b64b2 : Hex6 : 1 : 64 ) ) +
  224.                           Char( %lookup( b64b3 : Hex6 : 1 : 64 ) ) +
  225.                           '=';
  226.             when len = 1;
  227.               base64str = Char( %lookup( b64b1 : Hex6 : 1 : 64 ) ) +
  228.                           Char( %lookup( b64b2 : Hex6 : 1 : 64 ) ) +
  229.                           '==';
  230.           endsl;
  231.           base64len = base64len + 4;
  232.         endif;
  233.  
  234.         return base64len;
  235.  
  236.         begsr *pssr;
  237.           return 0;
  238.         endsr;
  239.  
  240.       /end-free
  241.      P                 E
  242.       *=============================================================================================
  243.       *‚base64_decode(): Decode plain text string from Base64
  244.       *
  245.       *‚Returns the length of the resulting decoded string or a negative
  246.       *‚number denoting the position of the error within the string
  247.       *=============================================================================================
  248.      P base64_decode   B                   export
  249.      D                 PI            10U 0
  250.      D   base64ptr                     *   value
  251.      D   base64len                   10U 0 value
  252.      D   plainptr                      *   value
  253.      D   plainsize                   10U 0 value
  254.       *---------------------------------------------------------------------------------------------
  255.      D base64str       DS                  based(base64ptr)
  256.      D   b64c1                        1A
  257.      D   b64c2                        1A
  258.      D   b64c3                        1A
  259.      D   b64c4                        1A
  260.  
  261.      D plainbit        DS
  262.      D   bits                         8A   Dim(3)
  263.  
  264.      D plainstr        S              3A   based(plainptr)
  265.      D plainlen        S             10I 0
  266.      D pos             S             10I 0
  267.      D len             S             10I 0
  268.      D x               S             10I 0
  269.       *---------------------------------------------------------------------------------------------
  270.       /free
  271.  
  272.         BaseArrPtr = Base64StrPtr;
  273.  
  274.         //‚Not enough space to decode string, so truncate
  275.         if base64_decode_len( base64ptr : base64len ) > plainsize;
  276.           base64len = %int( ( plainsize + 2  ) / 3 ) * 4;
  277.         endif;
  278.  
  279.         if base64len > 4;
  280.           dow pos < ( base64len - 4 );
  281.             plainbit = Hex6( %lookup( b64c1 : Char : 1 : 64 ) ) +
  282.                        Hex6( %lookup( b64c2 : Char : 1 : 64 ) ) +
  283.                        Hex6( %lookup( b64c3 : Char : 1 : 64 ) ) +
  284.                        Hex6( %lookup( b64c4 : Char : 1 : 64 ) );
  285.             plainstr = charform( plainbit : 24 );
  286.             plainptr = plainptr + 3;
  287.             plainlen = plainlen + 3;
  288.             base64ptr = base64ptr + 4;
  289.             pos = pos + 4;
  290.           enddo;
  291.           select;
  292.             when b64c3 = '=';
  293.               plainbit = Hex6( %lookup( b64c1 : Char : 1 : 64 ) ) +
  294.                          Hex6( %lookup( b64c2 : Char : 1 : 64 ) ) +
  295.                          '000000000000';
  296.               len = 1;
  297.             when b64c4 = '=';
  298.               plainbit = Hex6( %lookup( b64c1 : Char : 1 : 64 ) ) +
  299.                          Hex6( %lookup( b64c2 : Char : 1 : 64 ) ) +
  300.                          Hex6( %lookup( b64c3 : Char : 1 : 64 ) ) +
  301.                          '000000';
  302.               len = 2;
  303.             other;
  304.               plainbit = Hex6( %lookup( b64c1 : Char : 1 : 64 ) ) +
  305.                          Hex6( %lookup( b64c2 : Char : 1 : 64 ) ) +
  306.                          Hex6( %lookup( b64c3 : Char : 1 : 64 ) ) +
  307.                          Hex6( %lookup( b64c4 : Char : 1 : 64 ) );
  308.               len = 3;
  309.           endsl;
  310.           for x = 1 to len;
  311.             plainstr = charform( bits(x) : 8 );
  312.             plainptr = plainptr + 1;
  313.             plainlen = plainlen + 1;
  314.           endfor;
  315.         endif;
  316.  
  317.         return plainlen;
  318.  
  319.         begsr *pssr;
  320.           return 0;
  321.         endsr;
  322.  
  323.       /end-free
  324.      P                 E
  325.       *=============================================================================================
  326.       *‚base64_encode_len(): Return length of base64-encoded string
  327.       *=============================================================================================
  328.      P base64_encode_len...
  329.      P                 B                   export
  330.      D                 PI            10U 0
  331.      D   plainlen                    10U 0 value
  332.       *---------------------------------------------------------------------------------------------
  333.       /free
  334.  
  335.         return %int( ( plainlen + 2  ) / 3 ) * 4;
  336.  
  337.         begsr *pssr;
  338.           return 0;
  339.         endsr;
  340.  
  341.       /end-free
  342.      P                 E
  343.       *=============================================================================================
  344.       *‚base64_decode_len(): Return length of an unencoded string
  345.       *=============================================================================================
  346.      P base64_decode_len...
  347.      P                 B                   export
  348.      D                 PI            10U 0
  349.      D   base64ptr                     *   value
  350.      D   base64len                   10U 0 value
  351.       *---------------------------------------------------------------------------------------------
  352.      D char            S              1A   based(charptr)
  353.       *---------------------------------------------------------------------------------------------
  354.       /free
  355.  
  356.         BaseArrPtr = Base64StrPtr;
  357.  
  358.         charptr = base64ptr + base64len - 2;
  359.         if char = '=';
  360.           return ( ( base64len / 4 ) * 3 ) - 2;
  361.         else;
  362.           charptr = charptr + 1;
  363.           if char = '=';
  364.             return ( ( base64len / 4 ) * 3 ) - 1;
  365.           else;
  366.             return ( base64len / 4 ) * 3;
  367.           endif;
  368.         endif;
  369.  
  370.         begsr *pssr;
  371.           return 0;
  372.         endsr;
  373.  
  374.       /end-free
  375.      P                 E
  376.       *=============================================================================================
  377.       *‚base32_encode(): Encode plain text string into Base32
  378.       *
  379.       *‚Returns the length of the resulting encoded string or a negative
  380.       *‚number denoting the position of the error within the string
  381.       *=============================================================================================
  382.      P base32_encode   B                   export
  383.      D                 PI            10U 0
  384.      D   plainptr                      *   value
  385.      D   plainlen                    10U 0 value
  386.      D   base32ptr                     *   value
  387.      D   base32size                  10U 0 value
  388.       *---------------------------------------------------------------------------------------------
  389.      D plainstr        S              5A   Based(plainptr)
  390.  
  391.      D base32bit       DS
  392.      D   b32b1                        5A
  393.      D   b32b2                        5A
  394.      D   b32b3                        5A
  395.      D   b32b4                        5A
  396.      D   b32b5                        5A
  397.      D   b32b6                        5A
  398.      D   b32b7                        5A
  399.      D   b32b8                        5A
  400.  
  401.      D base32str       S              8A   based(base32ptr)
  402.      D base32len       S             10I 0 inz
  403.      D pos             S             10I 0 inz
  404.      D len             S             10I 0 inz
  405.       *---------------------------------------------------------------------------------------------
  406.       /free
  407.  
  408.         BaseArrPtr = Base32StrPtr;
  409.  
  410.         //‚Not enough space to encode string, so truncate
  411.         if base32_encode_len( plainlen ) > base32size;
  412.           plainlen = %int( base32size / 8 ) * 5;
  413.         endif;
  414.  
  415.         if plainlen > 7;
  416.           dow pos <= ( plainlen - 5 );
  417.             base32bit = bitform( plainstr : 5 );
  418.             base32str = Char( %lookup( b32b1 : Hex5 : 1 : 32 ) ) +
  419.                         Char( %lookup( b32b2 : Hex5 : 1 : 32 ) ) +
  420.                         Char( %lookup( b32b3 : Hex5 : 1 : 32 ) ) +
  421.                         Char( %lookup( b32b4 : Hex5 : 1 : 32 ) ) +
  422.                         Char( %lookup( b32b5 : Hex5 : 1 : 32 ) ) +
  423.                         Char( %lookup( b32b6 : Hex5 : 1 : 32 ) ) +
  424.                         Char( %lookup( b32b7 : Hex5 : 1 : 32 ) ) +
  425.                         Char( %lookup( b32b8 : Hex5 : 1 : 32 ) );
  426.             base32ptr = base32ptr + 8;
  427.             base32len = base32len + 8;
  428.             plainptr = plainptr + 5;
  429.             pos = pos + 5;
  430.           enddo;
  431.         endif;
  432.         if plainlen > pos;
  433.           len = plainlen - pos;
  434.           base32bit = bitform( plainstr : len );
  435.           %subst( base32bit : ( len * 8 ) + 1 ) = *all'0';
  436.           select;
  437.             when len = 1;
  438.               base32str = Char( %lookup( b32b1 : Hex5 : 1 : 32 ) ) +
  439.                           Char( %lookup( b32b2 : Hex5 : 1 : 32 ) ) +
  440.                           '========';
  441.             when len = 2;
  442.               base32str = Char( %lookup( b32b1 : Hex5 : 1 : 32 ) ) +
  443.                           Char( %lookup( b32b2 : Hex5 : 1 : 32 ) ) +
  444.                           Char( %lookup( b32b3 : Hex5 : 1 : 32 ) ) +
  445.                           Char( %lookup( b32b4 : Hex5 : 1 : 32 ) ) +
  446.                           '====';
  447.             when len = 3;
  448.               base32str = Char( %lookup( b32b1 : Hex5 : 1 : 32 ) ) +
  449.                           Char( %lookup( b32b2 : Hex5 : 1 : 32 ) ) +
  450.                           Char( %lookup( b32b3 : Hex5 : 1 : 32 ) ) +
  451.                           Char( %lookup( b32b4 : Hex5 : 1 : 32 ) ) +
  452.                           Char( %lookup( b32b5 : Hex5 : 1 : 32 ) ) +
  453.                           '===';
  454.             when len = 4;
  455.               base32str = Char( %lookup( b32b1 : Hex5 : 1 : 32 ) ) +
  456.                           Char( %lookup( b32b2 : Hex5 : 1 : 32 ) ) +
  457.                           Char( %lookup( b32b3 : Hex5 : 1 : 32 ) ) +
  458.                           Char( %lookup( b32b4 : Hex5 : 1 : 32 ) ) +
  459.                           Char( %lookup( b32b5 : Hex5 : 1 : 32 ) ) +
  460.                           Char( %lookup( b32b6 : Hex5 : 1 : 32 ) ) +
  461.                           Char( %lookup( b32b7 : Hex5 : 1 : 32 ) ) +
  462.                           '=';
  463.           endsl;
  464.           base32len = base32len + 8;
  465.         endif;
  466.  
  467.         return base32len;
  468.  
  469.         begsr *pssr;
  470.           return 0;
  471.         endsr;
  472.  
  473.       /end-free
  474.      P                 E
  475.       *=============================================================================================
  476.       *‚base32_decode(): Decode plain text string from Base32
  477.       *
  478.       *‚Returns the length of the resulting decoded string or a negative
  479.       *‚number denoting the position of the error within the string
  480.       *=============================================================================================
  481.      P base32_decode   B                   export
  482.      D                 PI            10U 0
  483.      D   base32ptr                     *   value
  484.      D   base32len                   10U 0 value
  485.      D   plainptr                      *   value
  486.      D   plainsize                   10U 0 value
  487.       *---------------------------------------------------------------------------------------------
  488.      D base32str       DS                  based(base32ptr)
  489.      D   b32c1                        1A
  490.      D   b32c2                        1A
  491.      D   b32c3                        1A
  492.      D   b32c4                        1A
  493.      D   b32c5                        1A
  494.      D   b32c6                        1A
  495.      D   b32c7                        1A
  496.      D   b32c8                        1A
  497.  
  498.      D plainbit        DS
  499.      D   bits                         8A   Dim(5)
  500.  
  501.      D plainstr        S              5A   based(plainptr)
  502.      D plainlen        S             10I 0
  503.      D pos             S             10I 0
  504.      D len             S             10I 0
  505.      D x               S             10I 0
  506.       *---------------------------------------------------------------------------------------------
  507.       /free
  508.  
  509.         BaseArrPtr = Base32StrPtr;
  510.  
  511.         //‚Not enough space to decode string, so truncate
  512.         if base32_decode_len( base32ptr : base32len ) > plainsize;
  513.           base32len = %int( ( plainsize + 4  ) / 5 ) * 8;
  514.         endif;
  515.  
  516.         if base32len > 8;
  517.           dow pos < ( base32len - 8 );
  518.             plainbit = Hex5( %lookup( b32c1 : Char : 1 : 32 ) ) +
  519.                        Hex5( %lookup( b32c2 : Char : 1 : 32 ) ) +
  520.                        Hex5( %lookup( b32c3 : Char : 1 : 32 ) ) +
  521.                        Hex5( %lookup( b32c4 : Char : 1 : 32 ) ) +
  522.                        Hex5( %lookup( b32c5 : Char : 1 : 32 ) ) +
  523.                        Hex5( %lookup( b32c6 : Char : 1 : 32 ) ) +
  524.                        Hex5( %lookup( b32c7 : Char : 1 : 32 ) ) +
  525.                        Hex5( %lookup( b32c8 : Char : 1 : 32 ) );
  526.             plainstr = charform( plainbit : 40 );
  527.             plainptr = plainptr + 5;
  528.             plainlen = plainlen + 5;
  529.             base32ptr = base32ptr + 8;
  530.             pos = pos + 8;
  531.           enddo;
  532.           select;
  533.             when b32c3 = '=';
  534.               plainbit = Hex5( %lookup( b32c1 : Char : 1 : 32 ) ) +
  535.                          Hex5( %lookup( b32c2 : Char : 1 : 32 ) ) +
  536.                          '000000000000000000000000000000';
  537.               len = 1;
  538.             when b32c5 = '=';
  539.               plainbit = Hex5( %lookup( b32c1 : Char : 1 : 32 ) ) +
  540.                          Hex5( %lookup( b32c2 : Char : 1 : 32 ) ) +
  541.                          Hex5( %lookup( b32c3 : Char : 1 : 32 ) ) +
  542.                          Hex5( %lookup( b32c4 : Char : 1 : 32 ) ) +
  543.                          '00000000000000000000';
  544.               len = 2;
  545.             when b32c6 = '=';
  546.               plainbit = Hex5( %lookup( b32c1 : Char : 1 : 32 ) ) +
  547.                          Hex5( %lookup( b32c2 : Char : 1 : 32 ) ) +
  548.                          Hex5( %lookup( b32c3 : Char : 1 : 32 ) ) +
  549.                          Hex5( %lookup( b32c4 : Char : 1 : 32 ) ) +
  550.                          Hex5( %lookup( b32c5 : Char : 1 : 32 ) ) +
  551.                          '0000000000';
  552.               len = 3;
  553.             when b32c8 = '=';
  554.               plainbit = Hex5( %lookup( b32c1 : Char : 1 : 32 ) ) +
  555.                          Hex5( %lookup( b32c2 : Char : 1 : 32 ) ) +
  556.                          Hex5( %lookup( b32c3 : Char : 1 : 32 ) ) +
  557.                          Hex5( %lookup( b32c4 : Char : 1 : 32 ) ) +
  558.                          Hex5( %lookup( b32c5 : Char : 1 : 32 ) ) +
  559.                          Hex5( %lookup( b32c6 : Char : 1 : 32 ) ) +
  560.                          Hex5( %lookup( b32c7 : Char : 1 : 32 ) ) +
  561.                          '00000';
  562.               len = 4;
  563.             other;
  564.               plainbit = Hex5( %lookup( b32c1 : Char : 1 : 32 ) ) +
  565.                          Hex5( %lookup( b32c2 : Char : 1 : 32 ) ) +
  566.                          Hex5( %lookup( b32c3 : Char : 1 : 32 ) ) +
  567.                          Hex5( %lookup( b32c4 : Char : 1 : 32 ) ) +
  568.                          Hex5( %lookup( b32c5 : Char : 1 : 32 ) ) +
  569.                          Hex5( %lookup( b32c6 : Char : 1 : 32 ) ) +
  570.                          Hex5( %lookup( b32c7 : Char : 1 : 32 ) ) +
  571.                          Hex5( %lookup( b32c8 : Char : 1 : 32 ) );
  572.               len = 5;
  573.           endsl;
  574.           for x = 1 to len;
  575.             plainstr = charform( bits(x) : 8 );
  576.             plainptr = plainptr + 1;
  577.             plainlen = plainlen + 1;
  578.           endfor;
  579.         endif;
  580.  
  581.         return plainlen;
  582.  
  583.         begsr *pssr;
  584.           return 0;
  585.         endsr;
  586.  
  587.       /end-free
  588.      P                 E
  589.       *=============================================================================================
  590.       *‚base32_encode_len(): Return length of base32-encoded string
  591.       *=============================================================================================
  592.      P base32_encode_len...
  593.      P                 B                   export
  594.      D                 PI            10U 0
  595.      D   plainlen                    10U 0 value
  596.       *---------------------------------------------------------------------------------------------
  597.       /free
  598.  
  599.         return %int( ( plainlen + 4  ) / 5 ) * 8;
  600.  
  601.         begsr *pssr;
  602.           return 0;
  603.         endsr;
  604.  
  605.       /end-free
  606.      P                 E
  607.       *=============================================================================================
  608.       *‚base32_decode_len(): Return length of an unencoded string
  609.       *=============================================================================================
  610.      P base32_decode_len...
  611.      P                 B                   export
  612.      D                 PI            10U 0
  613.      D   base32ptr                     *   value
  614.      D   base32len                   10U 0 value
  615.       *---------------------------------------------------------------------------------------------
  616.      D char            S              1A   based(charptr)
  617.       *---------------------------------------------------------------------------------------------
  618.       /free
  619.  
  620.         BaseArrPtr = Base32StrPtr;
  621.  
  622.         charptr = base32ptr + base32len - 6;
  623.         if char = '=';
  624.           return ( ( base32len / 8 ) * 5 ) - 6;
  625.         else;
  626.           charptr = charptr + 2;
  627.           if char = '=';
  628.             return ( ( base32len / 8 ) * 5 ) - 4;
  629.           else;
  630.             charptr = charptr + 1;
  631.             if char = '=';
  632.               return ( base32len / 8 ) * 5 - 3;
  633.             else;
  634.               charptr = charptr + 2;
  635.               if char = '=';
  636.                 return ( base32len / 8 ) * 5 - 1;
  637.               else;
  638.                 return ( base32len / 8 ) * 5;
  639.               endif;
  640.             endif;
  641.           endif;
  642.         endif;
  643.  
  644.         begsr *pssr;
  645.           return 0;
  646.         endsr;
  647.  
  648.       /end-free
  649.      P                 E
  650.       *=====================================================================
  651.       *‚INTERNAL PROCEDURES
  652.       *=====================================================================
  653.       *‚bitform(): Get bit pattern of a character string
  654.       *=====================================================================
  655.      P bitform         B
  656.      D                 PI           512A
  657.      D String                        32A   Const
  658.      D StringLen                     10I 0 Const
  659.       *---------------------------------------------------------------------
  660.      D Pos             S             10I 0 Inz(1)
  661.      D Char            S              1A   Inz
  662.      D RtnVal          S            512A   Inz
  663.      D SavInd          S              8A   Inz
  664.      D WrkInd          S              8A   Inz
  665.       *---------------------------------------------------------------------
  666.  
  667.       *‚Save existing indicators 50 - 57.
  668.  
  669.      C                   Movea     *IN(50)       SavInd
  670.  
  671.      C     1             Do        StringLen     Pos
  672.  
  673.      C                   Eval      Char = %subst( String : Pos : 1 )
  674.  
  675.      C                   Testb     '0'           Char                     50    (on)
  676.      C                   Testb     '1'           Char                     51    (on)
  677.      C                   Testb     '2'           Char                     52    (on)
  678.      C                   Testb     '3'           Char                     53    (on)
  679.      C                   Testb     '4'           Char                     54    (on)
  680.      C                   Testb     '5'           Char                     55    (on)
  681.      C                   Testb     '6'           Char                     56    (on)
  682.      C                   Testb     '7'           Char                     57    (on)
  683.  
  684.       *‚Update return value
  685.  
  686.      C                   Movea     *IN(50)       WrkInd
  687.      C                   Eval      %subst( RtnVal : (Pos * 8) - 7 ) = WrkInd
  688.  
  689.      C                   Enddo
  690.  
  691.       *‚Set up return value, reset original indicators 50 - 57 and return.
  692.  
  693.      C                   Movea     SavInd        *IN(50)
  694.      C                   Return    RtnVal
  695.  
  696.      C     *PSSR         Begsr
  697.      C                   Movea     SavInd        *IN(50)
  698.      C                   Return    *All'0'
  699.      C                   Endsr
  700.  
  701.      P                 E
  702.       *=====================================================================
  703.       *‚charform(): Get character string of a bit pattern
  704.       *=====================================================================
  705.      P charform        B
  706.      D                 PI            32A
  707.      D   string                     512A   Value
  708.      D   stringlen                   10I 0 Value
  709.       *---------------------------------------------------------------------
  710.      D Pos             S             10I 0 Inz(1)
  711.      D Char            S              1A   Inz
  712.      D RtnVal          S             32A   Inz Varying
  713.      D Bits            S              1A   Dim(8) Based(BitsPtr)
  714.       *---------------------------------------------------------------------
  715.  
  716.      C                   Dow       Pos < StringLen
  717.  
  718.      C                   Eval      BitsPtr = %addr( String ) + Pos - 1
  719.  
  720.      C                   Eval      Char = x'00'
  721.      C     Bits(1)       Ifeq      '1'
  722.      C                   Biton     '0'           Char
  723.      C                   Endif
  724.      C     Bits(2)       Ifeq      '1'
  725.      C                   Biton     '1'           Char
  726.      C                   Endif
  727.      C     Bits(3)       Ifeq      '1'
  728.      C                   Biton     '2'           Char
  729.      C                   Endif
  730.      C     Bits(4)       Ifeq      '1'
  731.      C                   Biton     '3'           Char
  732.      C                   Endif
  733.      C     Bits(5)       Ifeq      '1'
  734.      C                   Biton     '4'           Char
  735.      C                   Endif
  736.      C     Bits(6)       Ifeq      '1'
  737.      C                   Biton     '5'           Char
  738.      C                   Endif
  739.      C     Bits(7)       Ifeq      '1'
  740.      C                   Biton     '6'           Char
  741.      C                   Endif
  742.      C     Bits(8)       Ifeq      '1'
  743.      C                   Biton     '7'           Char
  744.      C                   Endif
  745.  
  746.      C                   Eval      RtnVal = RtnVal + Char
  747.      C                   Eval      Pos = Pos + 8
  748.  
  749.      C                   Enddo
  750.  
  751.      C                   Return    RtnVal
  752.  
  753.      C     *PSSR         Begsr
  754.      C                   Return    *Blanks
  755.      C                   Endsr
  756.  
  757.      P                 E
  758.       *=====================================================================
  759.  
© 2004-2019 by midrange.com generated in 0.01s valid xhtml & css