midrange.com code scratchpad
Name:
Email Prompt (and associated) Sub-Procedure With Display File
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
08/20/2014 06:14:39 pm
IP:
Logged
Description:
This is the code used to create the Sub-Procedures Mentioned. Prototypes located in separate prototype file, not included here (easy to re-produce...)

I'm a new programmer - don't kill me over everything in here. Just supplying to help anyone who might want it.
Code:
  1.        //Example Calls
  2.        //=======================================================================
  3. myEmail = ChrGetEmail; //All = Defaults
  4. myEmail = ChrGetEmail(myPgm); //Custom Pgm Name - All Else = Defaults
  5. myEmail = ChrGetEmail(myPgm:myTitle:'Please Enter Email'); 
  6. myEmail = ChrGetEmail(myPgm:myTitle:myMsg1:myMsg2:myError); //Completely Customized
  7.  
  8.  
  9.        //DDS (EMAILFM.DSPF)
  10.        //=======================================================================
  11.      A                                      DSPSIZ(24 80 *DS3)
  12.      A                                      INDARA
  13.      A                                      PRINT
  14.      A          R EMAIL1
  15.      A                                      WINDOW(5 5 11 67)
  16.      A                                      WDWBORDER((*COLOR BLU) (*DSPATR RI)-
  17.      A                                       (*CHAR '        '))
  18.      A                                      CF12(12)
  19.      A                                      CF03(03)
  20.      A                                      WDWTITLE((*TEXT '    ENTER-Continue-
  21.      A                                                                         -
  22.      A                                        F12-Cancel') *BOTTOM *LEFT)
  23.      A                                  8  1'EMail Address:'
  24.      A                                      COLOR(WHT)
  25.      A            EMLEMAIL      50A  B  8 16
  26.      A            EMLTITLE      40      1 14COLOR(WHT)
  27.      A            EMLMSG1       66   O  4  1COLOR(BLU)
  28.      A            EMLMSG2       66   O  5  1COLOR(BLU)
  29.      A            EMLERROR      65A  O 10  2DSPATR(HI)
  30.      A                                      DSPATR(BL)
  31.      A                                      COLOR(RED)
  32.      A                                  1  1USER
  33.      A                                  1 59DATE
  34.      A                                      EDTCDE(Y)
  35.      A                                  2 59TIME
  36.      A            EMLPGM        10   O  2  1
  37.      A          R ASSUMEEML
  38.      A                                      ASSUME
  39.      A                                  5  1' 
  40.  
  41.  
  42.        //Get email address for any purpose.
  43.        //=======================================================================
  44.      PChrGetEmail      B                   Export
  45.      FEMAILFM   CF   E             WORKSTN InDDS(DSIndAra)
  46.      DChrGetEmail      PI           100A   Varying
  47.      D PgmName                       10A   Const Options(*NoPass)
  48.      D Title                         40A   Const Options(*NoPass)
  49.      D Msg1                          66A   Const Options(*NoPass)
  50.      D Msg2                          66A   Const Options(*NoPass)
  51.      D Error                         65A   Const Options(*NoPass)
  52.       //Local Variables
  53.      DDSEmail          DS                  LikeRec(EMAIL1:*all)
  54.      DDSIndAra         DS
  55.      D F3                      3      3N
  56.      D F12                    12     12N
  57.      DOutput           S            100A
  58.       /Free
  59.  
  60.          If %parms >= 1;
  61.            DSEmail.EmlPgm = PgmName;
  62.          Else;
  63.            DSEmail.EmlPgm = 'CHRTOOLS';
  64.          EndIf;
  65.  
  66.          If %parms >= 2;
  67.            DSEmail.EmlTitle = Title;
  68.          Else;
  69.            DSEmail.EmlTitle = 'Get Email Address';
  70.          EndIf;
  71.          DSEmail.EmlTitle = ChrCenterThis(DSEmail.EmlTitle);
  72.  
  73.          If %parms >= 3;
  74.            DSEmail.EmlMsg1 = Msg1;
  75.          Else;
  76.            DSEmail.EmlMsg1 = 'Enter a Valid Email Address';
  77.          EndIf;
  78.          DSEmail.EmlMsg1 = ChrCenterThis(DSEmail.EmlMsg1);
  79.  
  80.          If %parms >= 4;
  81.            DSEmail.EmlMsg2 = ChrCenterThis(Msg2);
  82.          Else;
  83.            Clear DSEmail.EmlMsg2;
  84.          EndIf;
  85.  
  86.          If %parms = 5;
  87.            DSEmail.EmlError = Error;
  88.          Else;
  89.            Clear DSEmail.EmlError;
  90.          EndIf;
  91.  
  92.          DoU F3 = *On or F12 = *On;
  93.            ExFmt Email1 DSEmail;
  94.            Clear DSEmail.EmlError;
  95.  
  96.            If F3 = *On or F12 = *On;
  97.              Clear Output;
  98.              Return Output;
  99.            EndIf;
  100.  
  101.            If DSEmail.EmlEmail = *Blanks;
  102.              DSEmail.EmlError = 'Blank Email';
  103.              Iter;
  104.            Else;
  105.              If Not ChrValEmail(DSEmail.EmlEmail);
  106.                DSEmail.EmlError = 'Invalid Email Addres';
  107.                Iter;
  108.              Else;
  109.                Output = DSEmail.EmlEmail;
  110.                Return Output;
  111.              EndIf;
  112.            EndIf;
  113.  
  114.          EndDo;
  115.  
  116.       /End-Free
  117.      PChrGetEmail      E
  118.  
  119.  
  120.  
  121.        //Center text into a field given it's length and contents.
  122.        //=======================================================================
  123.      PChrCenterThis    B                   Export
  124.      DChrCenterThis    PI         32740A   Varying
  125.      D InputStr                   32740A   Const Varying
  126.       //Local Variables
  127.      D Length          S             10I 0 Inz
  128.      D StrLength       S             10I 0 Inz
  129.      D Output          S          32740A
  130.       /Free
  131.  
  132.          StrLength = %len(InputStr);
  133.  
  134.          If StrLength > (%len(%trim(InputStr)) + 1);
  135.            Length = ((StrLength -
  136.                     %len(%trim(InputStr)))/2)+1;
  137.            %subst(Output:Length) = %trim(InputStr);
  138.            Return Output;
  139.          Else;
  140.            Return InputStr;
  141.          EndIf;
  142.  
  143.       /End-Free
  144.      PChrCenterThis    E
  145.  
  146.  
  147.  
  148.        //Determine if email address is valid - 'Y' = Valid, 'N' = Not Valid.
  149.        //=======================================================================
  150.      PChrValEmail      B                   Export
  151.      DChrValEmail      PI              N
  152.      D Email                        100A   Const Varying
  153.       //Local Variables
  154.      D Y1              S             10I 0 Inz
  155.      D MaxY1           S             10I 0 Inz
  156.      D Y2              S             10I 0 Inz
  157.      D MaxY2           S             10I 0 Inz
  158.      D StartPos        S             10I 0 Inz
  159.       /Free
  160.  
  161.          //Check for @ Symbol
  162.          StartPos = 1;
  163.          DoU Y1 = *zero;
  164.            Y1 = %scan('@':Email:StartPos);
  165.            If Y1 <> *zero;
  166.              MaxY1 = Y1;
  167.            EndIf;
  168.            If MaxY1 = *zero;
  169.              Return *Off;
  170.            ElseIf Y1 < %len(Email);
  171.              StartPos = Y1 + 1;
  172.            Else;
  173.              Leave;
  174.            EndIf;
  175.          EndDo;
  176.  
  177.          //Verify Address Exists Before Final @ Symbol
  178.          If MaxY1 <= 1;
  179.            Return *Off;
  180.          EndIf;
  181.  
  182.          //Check for . Separator
  183.          StartPos = 1;
  184.          DoU Y2 = *zero;
  185.            Y2 = %scan('.':Email:StartPos);
  186.            If Y2 <> *zero;
  187.              MaxY2 = Y2;
  188.            EndIf;
  189.            If MaxY2 = *zero;
  190.              Return *Off;
  191.            ElseIf Y2 < %len(Email);
  192.              StartPos = Y2 +1;
  193.            Else;
  194.              Leave;
  195.            EndIf;
  196.          EndDo;
  197.  
  198.          //Verify Domain Exists Before Final . Separator
  199.          If MaxY2 <= 3;
  200.            Return *Off;
  201.          EndIf;
  202.  
  203.          //Check for Final . Separator Comes Before Final @ Symbol
  204.          If MaxY1 > MaxY2;
  205.            Return *Off;
  206.          EndIf;
  207.  
  208.          //Verify Top-Level Domain Exists AFter Final . Separator
  209.          If %len(ChrGetExt(Email)) = 0; //Top-Level Domain Missing
  210.            Return *Off;
  211.          EndIf;
  212.  
  213.          //No Issues - Valid Email Format
  214.          Return *On;
  215.  
  216.       /End-Free
  217.      PChrValEmail      E
© 2004-2019 by midrange.com generated in 0.025s valid xhtml & css