midrange.com code scratchpad
Name:
Characters: RPG Code
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
08/20/2014 06:47:09 pm
IP:
Logged
Description:
The user was to lazy to give a description
Code:
  1.      H NOMAIN
  2.       /DEFINE Copy_ChrTools
  3.       /INCLUDE CDSRCLIB/QPROTOTYPE,COPYCOMMON
  4.  
  5.        //=======================================================================
  6.        //     ___ _         ___         _          _____ _    _
  7.        //    / __| |_  _ _ / __|___ _ _| |_ ___ _ |_   _| |_ (_)___
  8.        //   | (__| ' \| '_| (__/ -_) ' \  _/ -_) '_|| | | ' \| (_-<
  9.        //    \___|_||_|_|  \___\___|_||_\__\___|_|  |_| |_||_|_/__/
  10.        //
  11.        //Center text into a field given it's length and contents.
  12.        //=======================================================================
  13.      PChrCenterThis    B                   Export
  14.      DChrCenterThis    PI         32740A   Varying
  15.      D InputStr                   32740A   Const Varying
  16.       //Local Variables
  17.      D Length          S             10I 0 Inz
  18.      D StrLength       S             10I 0 Inz
  19.      D Output          S          32740A
  20.       /Free
  21.  
  22.          StrLength = %len(InputStr);
  23.  
  24.          If StrLength > (%len(%trim(InputStr)) + 1);
  25.            Length = ((StrLength -
  26.                     %len(%trim(InputStr)))/2)+1;
  27.            %subst(Output:Length) = %trim(InputStr);
  28.            Return Output;
  29.          Else;
  30.            Return InputStr;
  31.          EndIf;
  32.  
  33.       /End-Free
  34.      PChrCenterThis    E
  35.  
  36.  
  37.        //=======================================================================
  38.        //     ___ _         ___     _   ___            _ _
  39.        //    / __| |_  _ _ / __|___| |_| __|_ __  __ _(_) |
  40.        //   | (__| ' \| '_| (_ / -_)  _| _|| '  \/ _` | | |
  41.        //    \___|_||_|_|  \___\___|\__|___|_|_|_\__,_|_|_|
  42.        //
  43.        //Get email address for any purpose.
  44.        //=======================================================================
  45.      PChrGetEmail      B                   Export
  46.      FEMAILFM   CF   E             WORKSTN InDDS(DSIndAra)
  47.      DChrGetEmail      PI           100A   Varying
  48.      D PgmName                       10A   Const Options(*NoPass)
  49.      D Title                         40A   Const Options(*NoPass)
  50.      D Msg1                          66A   Const Options(*NoPass)
  51.      D Msg2                          66A   Const Options(*NoPass)
  52.      D Error                         65A   Const Options(*NoPass)
  53.       //Local Variables
  54.      DDSEmail          DS                  LikeRec(EMAIL1:*all)
  55.      DDSIndAra         DS
  56.      D F3                      3      3N
  57.      D F12                    12     12N
  58.      DOutput           S            100A
  59.       /Free
  60.  
  61.          If %parms >= 1;
  62.            DSEmail.EmlPgm = PgmName;
  63.          Else;
  64.            DSEmail.EmlPgm = 'CHRTOOLS';
  65.          EndIf;
  66.  
  67.          If %parms >= 2;
  68.            DSEmail.EmlTitle = Title;
  69.          Else;
  70.            DSEmail.EmlTitle = 'Get Email Address';
  71.          EndIf;
  72.          DSEmail.EmlTitle = ChrCenterThis(DSEmail.EmlTitle);
  73.  
  74.          If %parms >= 3;
  75.            DSEmail.EmlMsg1 = Msg1;
  76.          Else;
  77.            DSEmail.EmlMsg1 = 'Enter a Valid Email Address';
  78.          EndIf;
  79.          DSEmail.EmlMsg1 = ChrCenterThis(DSEmail.EmlMsg1);
  80.  
  81.          If %parms >= 4;
  82.            DSEmail.EmlMsg2 = ChrCenterThis(Msg2);
  83.          Else;
  84.            Clear DSEmail.EmlMsg2;
  85.          EndIf;
  86.  
  87.          If %parms = 5;
  88.            DSEmail.EmlError = Error;
  89.          Else;
  90.            Clear DSEmail.EmlError;
  91.          EndIf;
  92.  
  93.          DoU F3 = *On or F12 = *On;
  94.            ExFmt Email1 DSEmail;
  95.            Clear DSEmail.EmlError;
  96.  
  97.            If F3 = *On or F12 = *On;
  98.              Clear Output;
  99.              Return Output;
  100.            EndIf;
  101.  
  102.            If DSEmail.EmlEmail = *Blanks;
  103.              DSEmail.EmlError = 'Blank Email';
  104.              Iter;
  105.            Else;
  106.              If Not ChrValEmail(DSEmail.EmlEmail);
  107.                DSEmail.EmlError = 'Invalid Email Addres';
  108.                Iter;
  109.              Else;
  110.                Output = DSEmail.EmlEmail;
  111.                Return Output;
  112.              EndIf;
  113.            EndIf;
  114.  
  115.          EndDo;
  116.  
  117.       /End-Free
  118.      PChrGetEmail      E
  119.  
  120.  
  121.        //=======================================================================
  122.        //     ___ _         ___     _   ___     _
  123.        //    / __| |_  _ _ / __|___| |_| __|_ _| |_
  124.        //   | (__| ' \| '_| (_ / -_)  _| _|\ \ /  _|
  125.        //    \___|_||_|_|  \___\___|\__|___/_\_\\__|
  126.        //
  127.        //Get extension of a file given it's complete name.
  128.        //=======================================================================
  129.      PChrGetExt        B                   Export
  130.      DChrGetExt        PI         32740A   Varying
  131.      D InputStr                   32740A   Const Varying
  132.       //Local Variables
  133.      D FoundPos        S             10I 0 Inz
  134.      D StartPos        S             10I 0 Inz
  135.      D Output          S          32740A   Varying
  136.       /Free
  137.  
  138.          StartPos = 1;
  139.          DoU FoundPos = *zero;
  140.            FoundPos = %scan('.':InputStr:StartPos);
  141.            If FoundPos <> *zero;
  142.              If FoundPos < %len(InputStr);
  143.                StartPos = FoundPos + 1;
  144.              Else;
  145.                Clear FoundPos;
  146.                StartPos = 1;
  147.                Leave;
  148.              EndIf;
  149.            EndIf;
  150.          EndDo;
  151.  
  152.          Output = %subst(InputStr
  153.                          :StartPos
  154.                          :%len(%trim(InputStr))-(StartPos-1));
  155.          Return Output;
  156.  
  157.       /End-Free
  158.      PChrGetExt        E
  159.  
  160.  
  161.        //=======================================================================
  162.        //     ___ _         ___     _   _
  163.        //    / __| |_  _ _ / __|___| |_| |   _____ __ _____ _ _
  164.        //   | (__| ' \| '_| (_ / -_)  _| |__/ _ \ V  V / -_) '_|
  165.        //    \___|_||_|_|  \___\___|\__|____\___/\_/\_/\___|_|
  166.        //
  167.        //Convert Input to Lower Case.
  168.        //=======================================================================
  169.      PChrGetLower      B                   Export
  170.      DChrGetLower      PI         32740A   Varying
  171.      D InputStr                   32740A   Const Varying
  172.       //Local Variables
  173.      D Output          S          32740A   Varying
  174.       /Free
  175.  
  176.          Exec SQL Set :Output = Lower(:InputStr);
  177.          Return Output;
  178.  
  179.       /End-Free
  180.      PChrGetLower      E
  181.  
  182.  
  183.        //=======================================================================
  184.        //     ___ _         ___     _   _   _
  185.        //    / __| |_  _ _ / __|___| |_| | | |_ __ _ __  ___ _ _
  186.        //   | (__| ' \| '_| (_ / -_)  _| |_| | '_ \ '_ \/ -_) '_|
  187.        //    \___|_||_|_|  \___\___|\__|\___/| .__/ .__/\___|_|
  188.        //                                    |_|  |_|
  189.        //Convert Input to Upper Case.
  190.        //=======================================================================
  191.      PChrGetUpper      B                   Export
  192.      DChrGetUpper      PI         32740A   Varying
  193.      D InputStr                   32740A   Const Varying
  194.       //Local Variables
  195.      D Output          S          32740A   Varying
  196.       /Free
  197.  
  198.          Exec SQL Set :Output = Upper(:InputStr);
  199.          Return Output;
  200.  
  201.       /End-Free
  202.      PChrGetUpper      E
  203.  
  204.  
  205.        //=======================================================================
  206.        //     ___ _       ___ ___ ___
  207.        //    / __| |_  _ |_ _|_ _| __|
  208.        //   | (__| ' \| '_| | | || _|
  209.        //    \___|_||_|_||___|___|_|
  210.        //
  211.        //Allow for single line comparisons, fill field depending on result.
  212.        //=======================================================================
  213.      PChrIIF           B                   Export
  214.      DChrIIF           PI         32740A   Varying
  215.      D Condition                       N           Value
  216.      D True                       32740A   Varying Value
  217.      D False                      32740A   Varying Value
  218.       /Free
  219.  
  220.          If Condition;
  221.            Return True;
  222.          Else;
  223.            Return False;
  224.          EndIf;
  225.  
  226.       /End-Free
  227.      PChrIIF           E
  228.  
  229.  
  230.        //=======================================================================
  231.        //     ___ _       ___
  232.        //    / __| |_  _ |_ _|_ _
  233.        //   | (__| ' \| '_| || ' \
  234.        //    \___|_||_|_||___|_||_|
  235.        //
  236.        //Allow for Single Line "=" Comparison, True if Input IN Any Matches (Up
  237.        // to 20 Matches)
  238.        //=======================================================================
  239.      PChrIn            B                   Export
  240.      DChrIn            PI              N
  241.      D Input                      32740A   Const Varying
  242.      D Match1                     32740A   Const Varying
  243.      D Match2                     32740A   Const Varying
  244.      D Match3                     32740A   Const Varying Options(*NoPass)
  245.      D Match4                     32740A   Const Varying Options(*NoPass)
  246.      D Match5                     32740A   Const Varying Options(*NoPass)
  247.      D Match6                     32740A   Const Varying Options(*NoPass)
  248.      D Match7                     32740A   Const Varying Options(*NoPass)
  249.      D Match8                     32740A   Const Varying Options(*NoPass)
  250.      D Match9                     32740A   Const Varying Options(*NoPass)
  251.      D Match10                    32740A   Const Varying Options(*NoPass)
  252.      D Match11                    32740A   Const Varying Options(*NoPass)
  253.      D Match12                    32740A   Const Varying Options(*NoPass)
  254.      D Match13                    32740A   Const Varying Options(*NoPass)
  255.      D Match14                    32740A   Const Varying Options(*NoPass)
  256.      D Match15                    32740A   Const Varying Options(*NoPass)
  257.      D Match16                    32740A   Const Varying Options(*NoPass)
  258.      D Match17                    32740A   Const Varying Options(*NoPass)
  259.      D Match18                    32740A   Const Varying Options(*NoPass)
  260.      D Match19                    32740A   Const Varying Options(*NoPass)
  261.      D Match20                    32740A   Const Varying Options(*NoPass)
  262.       //Local Variables
  263.      D Match           S          32740A   Dim(20) Inz
  264.      D X               S             10I 0 Inz
  265.       /Free
  266.  
  267.          Match(1) = Match1;
  268.          Match(2) = Match2;
  269.          //In case only 2 variables are passed, set all others = to a guranteed
  270.          // passed parameter
  271.          For X = 3 to 20;
  272.            Match(X) = Match2;
  273.          EndFor;
  274.  
  275.          X = %parms;
  276.  
  277.          If %parms >= 4;
  278.            Match(3) = Match3;
  279.            if %parms >= 5;
  280.              Match(4) = Match4;
  281.              if %parms >= 6;
  282.                Match(5) = Match5;
  283.                if %parms >= 7;
  284.                  Match(6) = Match6;
  285.                  if %parms >= 8;
  286.                    Match(7) = Match7;
  287.                    if %parms >= 9;
  288.                      Match(8) = Match8;
  289.                      if %parms >= 10;
  290.                        Match(9) = Match9;
  291.                        if %parms >= 11;
  292.                          Match(10) = Match10;
  293.                          if %parms >= 12;
  294.                            Match(11) = Match11;
  295.                            if %parms >= 13;
  296.                              Match(12) = Match12;
  297.                              if %parms >= 14;
  298.                                Match(13) = Match13;
  299.                                if %parms >= 15;
  300.                                  Match(14) = Match14;
  301.                                  if %parms >= 16;
  302.                                    Match(15) = Match15;
  303.                                    if %parms >= 17;
  304.                                      Match(16) = Match16;
  305.                                      if %parms >= 18;
  306.                                        Match(17) = Match17;
  307.                                        if %parms >= 19;
  308.                                          Match(18) = Match18;
  309.                                          if %parms >= 20;
  310.                                            Match(19) = Match19;
  311.                                            if %parms >= 21;
  312.                                              Match(20) = Match20;
  313.                                            EndIf;
  314.                                          EndIf;
  315.                                        EndIf;
  316.                                      EndIf;
  317.                                    EndIf;
  318.                                  EndIf;
  319.                                EndIf;
  320.                              EndIf;
  321.                            EndIf;
  322.                          EndIf;
  323.                        EndIf;
  324.                      EndIf;
  325.                    EndIf;
  326.                  EndIf;
  327.                EndIf;
  328.              EndIf;
  329.            EndIf;
  330.          EndIf;
  331.  
  332.          For X = 1 to 20;
  333.            If Input = Match(X);
  334.              Return *On;
  335.            EndIf;
  336.          EndFor;
  337.  
  338.          //Doesn't have any matches
  339.          Return *Off;
  340.  
  341.       /End-Free
  342.      PChrIn            E
  343.  
  344.  
  345.        //=======================================================================
  346.        //     ___ _        ___ _____ _    _     _
  347.        //    / __| |_  _ _| _ \_   _(_)__| |__ / |
  348.        //   | (__| ' \| '_|   / | | | / _| / / | |
  349.        //    \___|_||_|_| |_|_\ |_| |_\__|_\_\ |_|
  350.        //
  351.        //Replace apostrophe (') with grave accent (`) for SQL and CL commands
  352.        // (Usually used for reports).
  353.        //=======================================================================
  354.      PChrRTick1        B                   Export
  355.      DChrRTick1        PI         32740A   Varying
  356.      D InputStr                   32740A   Const Varying
  357.       //Local Variables
  358.      D Output          S          32740A
  359.       /Free
  360.  
  361.          Exec SQL Set :Output = Replace(:InputStr,'''','`');
  362.          Return Output;
  363.  
  364.       /End-Free
  365.      PChrRTick1        E
  366.  
  367.  
  368.        //=======================================================================
  369.        //     ___ _        ___ _____ _    _     ___
  370.        //    / __| |_  _ _| _ \_   _(_)__| |__ |_  )
  371.        //   | (__| ' \| '_|   / | | | / _| / /  / /
  372.        //    \___|_||_|_| |_|_\ |_| |_\__|_\_\ /___|
  373.        //
  374.        //Replace apostrophe (') with 2 apostrophes ('') for SQL and CL commands.
  375.        // (Usually used for searches based on field that includes apostrophes).
  376.        //=======================================================================
  377.      PChrRTick2        B                   Export
  378.      DChrRTick2        PI         32740A   Varying
  379.      D InputStr                   32740A   Const Varying
  380.       //Local Variables
  381.      D Output          S          32740A
  382.       /Free
  383.  
  384.          Exec SQL Set :Output = Replace(:InputStr,'''','''''');
  385.          Return Output;
  386.  
  387.       /End-Free
  388.      PChrRTick2        E
  389.  
  390.  
  391.        //=======================================================================
  392.        //     ___ _        ___               ___      _
  393.        //    / __| |_  _ _/ __| __ __ _ _ _ | _ \_ __| |
  394.        //   | (__| ' \| '_\__ \/ _/ _` | ' \|   / '_ \ |
  395.        //    \___|_||_|_| |___/\__\__,_|_||_|_|_\ .__/_|
  396.        //                                       |_|
  397.        //Our version of %scanrpl - Scan for original character(s) and replace
  398.        // with replacement character(s).
  399.        //=======================================================================
  400.      PChrScanRpl       B                   Export
  401.      DChrScanRpl       PI         32740A   Varying
  402.      D InputStr                   32740A   Const Varying
  403.      D Orig                       32740A   Const Varying
  404.      D Rpl                        32740A   Const Varying
  405.       //Local Variables
  406.      D Output          S          32740A
  407.       /Free
  408.  
  409.          Exec SQL Set :Output = Replace(:InputStr,:Orig,:Rpl);
  410.          Return Output;
  411.  
  412.       /End-Free
  413.      PChrScanRpl       E
  414.  
  415.  
  416.        //=======================================================================
  417.        //     ___ _      __   __    _ ___            _ _
  418.        //    / __| |_  _ \ \ / /_ _| | __|_ __  __ _(_) |
  419.        //   | (__| ' \| '_\ V / _` | | _|| '  \/ _` | | |
  420.        //    \___|_||_|_|  \_/\__,_|_|___|_|_|_\__,_|_|_|
  421.        //
  422.        //Determine if email address is valid - 'Y' = Valid, 'N' = Not Valid.
  423.        //=======================================================================
  424.      PChrValEmail      B                   Export
  425.      DChrValEmail      PI              N
  426.      D Email                        100A   Const Varying
  427.       //Local Variables
  428.      D Y1              S             10I 0 Inz
  429.      D MaxY1           S             10I 0 Inz
  430.      D Y2              S             10I 0 Inz
  431.      D MaxY2           S             10I 0 Inz
  432.      D StartPos        S             10I 0 Inz
  433.       /Free
  434.  
  435.          //Check for @ Symbol
  436.          StartPos = 1;
  437.          DoU Y1 = *zero;
  438.            Y1 = %scan('@':Email:StartPos);
  439.            If Y1 <> *zero;
  440.              MaxY1 = Y1;
  441.            EndIf;
  442.            If MaxY1 = *zero;
  443.              Return *Off;
  444.            ElseIf Y1 < %len(Email);
  445.              StartPos = Y1 + 1;
  446.            Else;
  447.              Leave;
  448.            EndIf;
  449.          EndDo;
  450.  
  451.          //Verify Address Exists Before Final @ Symbol
  452.          If MaxY1 <= 1;
  453.            Return *Off;
  454.          EndIf;
  455.  
  456.          //Check for . Separator
  457.          StartPos = 1;
  458.          DoU Y2 = *zero;
  459.            Y2 = %scan('.':Email:StartPos);
  460.            If Y2 <> *zero;
  461.              MaxY2 = Y2;
  462.            EndIf;
  463.            If MaxY2 = *zero;
  464.              Return *Off;
  465.            ElseIf Y2 < %len(Email);
  466.              StartPos = Y2 +1;
  467.            Else;
  468.              Leave;
  469.            EndIf;
  470.          EndDo;
  471.  
  472.          //Verify Domain Exists Before Final . Separator
  473.          If MaxY2 <= 3;
  474.            Return *Off;
  475.          EndIf;
  476.  
  477.          //Check for Final . Separator Comes Before Final @ Symbol
  478.          If MaxY1 > MaxY2;
  479.            Return *Off;
  480.          EndIf;
  481.  
  482.          //Verify Top-Level Domain Exists AFter Final . Separator
  483.          If %len(ChrGetExt(Email)) = 0; //Top-Level Domain Missing
  484.            Return *Off;
  485.          EndIf;
  486.  
  487.          //No Issues - Valid Email Format
  488.          Return *On;
  489.  
  490.       /End-Free
  491.      PChrValEmail      E 
© 2004-2019 by midrange.com generated in 0.008s valid xhtml & css