Code:
- H NOMAIN
- /DEFINE Copy_ChrTools
- /INCLUDE CDSRCLIB/QPROTOTYPE,COPYCOMMON
-
- //=======================================================================
- // ___ _ ___ _ _____ _ _
- // / __| |_ _ _ / __|___ _ _| |_ ___ _ |_ _| |_ (_)___
- // | (__| ' \| '_| (__/ -_) ' \ _/ -_) '_|| | | ' \| (_-<
- // \___|_||_|_| \___\___|_||_\__\___|_| |_| |_||_|_/__/
- //
- //Center text into a field given it's length and contents.
- //=======================================================================
- PChrCenterThis B Export
- DChrCenterThis PI 32740A Varying
- D InputStr 32740A Const Varying
- //Local Variables
- D Length S 10I 0 Inz
- D StrLength S 10I 0 Inz
- D Output S 32740A
- /Free
-
- StrLength = %len(InputStr);
-
- If StrLength > (%len(%trim(InputStr)) + 1);
- Length = ((StrLength -
- %len(%trim(InputStr)))/2)+1;
- %subst(Output:Length) = %trim(InputStr);
- Return Output;
- Else;
- Return InputStr;
- EndIf;
-
- /End-Free
- PChrCenterThis E
-
-
- //=======================================================================
- // ___ _ ___ _ ___ _ _
- // / __| |_ _ _ / __|___| |_| __|_ __ __ _(_) |
- // | (__| ' \| '_| (_ / -_) _| _|| ' \/ _` | | |
- // \___|_||_|_| \___\___|\__|___|_|_|_\__,_|_|_|
- //
- //Get email address for any purpose.
- //=======================================================================
- PChrGetEmail B Export
- FEMAILFM CF E WORKSTN InDDS(DSIndAra)
- DChrGetEmail PI 100A Varying
- D PgmName 10A Const Options(*NoPass)
- D Title 40A Const Options(*NoPass)
- D Msg1 66A Const Options(*NoPass)
- D Msg2 66A Const Options(*NoPass)
- D Error 65A Const Options(*NoPass)
- //Local Variables
- DDSEmail DS LikeRec(EMAIL1:*all)
- DDSIndAra DS
- D F3 3 3N
- D F12 12 12N
- DOutput S 100A
- /Free
-
- If %parms >= 1;
- DSEmail.EmlPgm = PgmName;
- Else;
- DSEmail.EmlPgm = 'CHRTOOLS';
- EndIf;
-
- If %parms >= 2;
- DSEmail.EmlTitle = Title;
- Else;
- DSEmail.EmlTitle = 'Get Email Address';
- EndIf;
- DSEmail.EmlTitle = ChrCenterThis(DSEmail.EmlTitle);
-
- If %parms >= 3;
- DSEmail.EmlMsg1 = Msg1;
- Else;
- DSEmail.EmlMsg1 = 'Enter a Valid Email Address';
- EndIf;
- DSEmail.EmlMsg1 = ChrCenterThis(DSEmail.EmlMsg1);
-
- If %parms >= 4;
- DSEmail.EmlMsg2 = ChrCenterThis(Msg2);
- Else;
- Clear DSEmail.EmlMsg2;
- EndIf;
-
- If %parms = 5;
- DSEmail.EmlError = Error;
- Else;
- Clear DSEmail.EmlError;
- EndIf;
-
- DoU F3 = *On or F12 = *On;
- ExFmt Email1 DSEmail;
- Clear DSEmail.EmlError;
-
- If F3 = *On or F12 = *On;
- Clear Output;
- Return Output;
- EndIf;
-
- If DSEmail.EmlEmail = *Blanks;
- DSEmail.EmlError = 'Blank Email';
- Iter;
- Else;
- If Not ChrValEmail(DSEmail.EmlEmail);
- DSEmail.EmlError = 'Invalid Email Addres';
- Iter;
- Else;
- Output = DSEmail.EmlEmail;
- Return Output;
- EndIf;
- EndIf;
-
- EndDo;
-
- /End-Free
- PChrGetEmail E
-
-
- //=======================================================================
- // ___ _ ___ _ ___ _
- // / __| |_ _ _ / __|___| |_| __|_ _| |_
- // | (__| ' \| '_| (_ / -_) _| _|\ \ / _|
- // \___|_||_|_| \___\___|\__|___/_\_\\__|
- //
- //Get extension of a file given it's complete name.
- //=======================================================================
- PChrGetExt B Export
- DChrGetExt PI 32740A Varying
- D InputStr 32740A Const Varying
- //Local Variables
- D FoundPos S 10I 0 Inz
- D StartPos S 10I 0 Inz
- D Output S 32740A Varying
- /Free
-
- StartPos = 1;
- DoU FoundPos = *zero;
- FoundPos = %scan('.':InputStr:StartPos);
- If FoundPos <> *zero;
- If FoundPos < %len(InputStr);
- StartPos = FoundPos + 1;
- Else;
- Clear FoundPos;
- StartPos = 1;
- Leave;
- EndIf;
- EndIf;
- EndDo;
-
- Output = %subst(InputStr
- :StartPos
- :%len(%trim(InputStr))-(StartPos-1));
- Return Output;
-
- /End-Free
- PChrGetExt E
-
-
- //=======================================================================
- // ___ _ ___ _ _
- // / __| |_ _ _ / __|___| |_| | _____ __ _____ _ _
- // | (__| ' \| '_| (_ / -_) _| |__/ _ \ V V / -_) '_|
- // \___|_||_|_| \___\___|\__|____\___/\_/\_/\___|_|
- //
- //Convert Input to Lower Case.
- //=======================================================================
- PChrGetLower B Export
- DChrGetLower PI 32740A Varying
- D InputStr 32740A Const Varying
- //Local Variables
- D Output S 32740A Varying
- /Free
-
- Exec SQL Set :Output = Lower(:InputStr);
- Return Output;
-
- /End-Free
- PChrGetLower E
-
-
- //=======================================================================
- // ___ _ ___ _ _ _
- // / __| |_ _ _ / __|___| |_| | | |_ __ _ __ ___ _ _
- // | (__| ' \| '_| (_ / -_) _| |_| | '_ \ '_ \/ -_) '_|
- // \___|_||_|_| \___\___|\__|\___/| .__/ .__/\___|_|
- // |_| |_|
- //Convert Input to Upper Case.
- //=======================================================================
- PChrGetUpper B Export
- DChrGetUpper PI 32740A Varying
- D InputStr 32740A Const Varying
- //Local Variables
- D Output S 32740A Varying
- /Free
-
- Exec SQL Set :Output = Upper(:InputStr);
- Return Output;
-
- /End-Free
- PChrGetUpper E
-
-
- //=======================================================================
- // ___ _ ___ ___ ___
- // / __| |_ _ |_ _|_ _| __|
- // | (__| ' \| '_| | | || _|
- // \___|_||_|_||___|___|_|
- //
- //Allow for single line comparisons, fill field depending on result.
- //=======================================================================
- PChrIIF B Export
- DChrIIF PI 32740A Varying
- D Condition N Value
- D True 32740A Varying Value
- D False 32740A Varying Value
- /Free
-
- If Condition;
- Return True;
- Else;
- Return False;
- EndIf;
-
- /End-Free
- PChrIIF E
-
-
- //=======================================================================
- // ___ _ ___
- // / __| |_ _ |_ _|_ _
- // | (__| ' \| '_| || ' \
- // \___|_||_|_||___|_||_|
- //
- //Allow for Single Line "=" Comparison, True if Input IN Any Matches (Up
- // to 20 Matches)
- //=======================================================================
- PChrIn B Export
- DChrIn PI N
- D Input 32740A Const Varying
- D Match1 32740A Const Varying
- D Match2 32740A Const Varying
- D Match3 32740A Const Varying Options(*NoPass)
- D Match4 32740A Const Varying Options(*NoPass)
- D Match5 32740A Const Varying Options(*NoPass)
- D Match6 32740A Const Varying Options(*NoPass)
- D Match7 32740A Const Varying Options(*NoPass)
- D Match8 32740A Const Varying Options(*NoPass)
- D Match9 32740A Const Varying Options(*NoPass)
- D Match10 32740A Const Varying Options(*NoPass)
- D Match11 32740A Const Varying Options(*NoPass)
- D Match12 32740A Const Varying Options(*NoPass)
- D Match13 32740A Const Varying Options(*NoPass)
- D Match14 32740A Const Varying Options(*NoPass)
- D Match15 32740A Const Varying Options(*NoPass)
- D Match16 32740A Const Varying Options(*NoPass)
- D Match17 32740A Const Varying Options(*NoPass)
- D Match18 32740A Const Varying Options(*NoPass)
- D Match19 32740A Const Varying Options(*NoPass)
- D Match20 32740A Const Varying Options(*NoPass)
- //Local Variables
- D Match S 32740A Dim(20) Inz
- D X S 10I 0 Inz
- /Free
-
- Match(1) = Match1;
- Match(2) = Match2;
- //In case only 2 variables are passed, set all others = to a guranteed
- // passed parameter
- For X = 3 to 20;
- Match(X) = Match2;
- EndFor;
-
- X = %parms;
-
- If %parms >= 4;
- Match(3) = Match3;
- if %parms >= 5;
- Match(4) = Match4;
- if %parms >= 6;
- Match(5) = Match5;
- if %parms >= 7;
- Match(6) = Match6;
- if %parms >= 8;
- Match(7) = Match7;
- if %parms >= 9;
- Match(8) = Match8;
- if %parms >= 10;
- Match(9) = Match9;
- if %parms >= 11;
- Match(10) = Match10;
- if %parms >= 12;
- Match(11) = Match11;
- if %parms >= 13;
- Match(12) = Match12;
- if %parms >= 14;
- Match(13) = Match13;
- if %parms >= 15;
- Match(14) = Match14;
- if %parms >= 16;
- Match(15) = Match15;
- if %parms >= 17;
- Match(16) = Match16;
- if %parms >= 18;
- Match(17) = Match17;
- if %parms >= 19;
- Match(18) = Match18;
- if %parms >= 20;
- Match(19) = Match19;
- if %parms >= 21;
- Match(20) = Match20;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
- EndIf;
-
- For X = 1 to 20;
- If Input = Match(X);
- Return *On;
- EndIf;
- EndFor;
-
- //Doesn't have any matches
- Return *Off;
-
- /End-Free
- PChrIn E
-
-
- //=======================================================================
- // ___ _ ___ _____ _ _ _
- // / __| |_ _ _| _ \_ _(_)__| |__ / |
- // | (__| ' \| '_| / | | | / _| / / | |
- // \___|_||_|_| |_|_\ |_| |_\__|_\_\ |_|
- //
- //Replace apostrophe (') with grave accent (`) for SQL and CL commands
- // (Usually used for reports).
- //=======================================================================
- PChrRTick1 B Export
- DChrRTick1 PI 32740A Varying
- D InputStr 32740A Const Varying
- //Local Variables
- D Output S 32740A
- /Free
-
- Exec SQL Set :Output = Replace(:InputStr,'''','`');
- Return Output;
-
- /End-Free
- PChrRTick1 E
-
-
- //=======================================================================
- // ___ _ ___ _____ _ _ ___
- // / __| |_ _ _| _ \_ _(_)__| |__ |_ )
- // | (__| ' \| '_| / | | | / _| / / / /
- // \___|_||_|_| |_|_\ |_| |_\__|_\_\ /___|
- //
- //Replace apostrophe (') with 2 apostrophes ('') for SQL and CL commands.
- // (Usually used for searches based on field that includes apostrophes).
- //=======================================================================
- PChrRTick2 B Export
- DChrRTick2 PI 32740A Varying
- D InputStr 32740A Const Varying
- //Local Variables
- D Output S 32740A
- /Free
-
- Exec SQL Set :Output = Replace(:InputStr,'''','''''');
- Return Output;
-
- /End-Free
- PChrRTick2 E
-
-
- //=======================================================================
- // ___ _ ___ ___ _
- // / __| |_ _ _/ __| __ __ _ _ _ | _ \_ __| |
- // | (__| ' \| '_\__ \/ _/ _` | ' \| / '_ \ |
- // \___|_||_|_| |___/\__\__,_|_||_|_|_\ .__/_|
- // |_|
- //Our version of %scanrpl - Scan for original character(s) and replace
- // with replacement character(s).
- //=======================================================================
- PChrScanRpl B Export
- DChrScanRpl PI 32740A Varying
- D InputStr 32740A Const Varying
- D Orig 32740A Const Varying
- D Rpl 32740A Const Varying
- //Local Variables
- D Output S 32740A
- /Free
-
- Exec SQL Set :Output = Replace(:InputStr,:Orig,:Rpl);
- Return Output;
-
- /End-Free
- PChrScanRpl E
-
-
- //=======================================================================
- // ___ _ __ __ _ ___ _ _
- // / __| |_ _ \ \ / /_ _| | __|_ __ __ _(_) |
- // | (__| ' \| '_\ V / _` | | _|| ' \/ _` | | |
- // \___|_||_|_| \_/\__,_|_|___|_|_|_\__,_|_|_|
- //
- //Determine if email address is valid - 'Y' = Valid, 'N' = Not Valid.
- //=======================================================================
- PChrValEmail B Export
- DChrValEmail PI N
- D Email 100A Const Varying
- //Local Variables
- D Y1 S 10I 0 Inz
- D MaxY1 S 10I 0 Inz
- D Y2 S 10I 0 Inz
- D MaxY2 S 10I 0 Inz
- D StartPos S 10I 0 Inz
- /Free
-
- //Check for @ Symbol
- StartPos = 1;
- DoU Y1 = *zero;
- Y1 = %scan('@':Email:StartPos);
- If Y1 <> *zero;
- MaxY1 = Y1;
- EndIf;
- If MaxY1 = *zero;
- Return *Off;
- ElseIf Y1 < %len(Email);
- StartPos = Y1 + 1;
- Else;
- Leave;
- EndIf;
- EndDo;
-
- //Verify Address Exists Before Final @ Symbol
- If MaxY1 <= 1;
- Return *Off;
- EndIf;
-
- //Check for . Separator
- StartPos = 1;
- DoU Y2 = *zero;
- Y2 = %scan('.':Email:StartPos);
- If Y2 <> *zero;
- MaxY2 = Y2;
- EndIf;
- If MaxY2 = *zero;
- Return *Off;
- ElseIf Y2 < %len(Email);
- StartPos = Y2 +1;
- Else;
- Leave;
- EndIf;
- EndDo;
-
- //Verify Domain Exists Before Final . Separator
- If MaxY2 <= 3;
- Return *Off;
- EndIf;
-
- //Check for Final . Separator Comes Before Final @ Symbol
- If MaxY1 > MaxY2;
- Return *Off;
- EndIf;
-
- //Verify Top-Level Domain Exists AFter Final . Separator
- If %len(ChrGetExt(Email)) = 0; //Top-Level Domain Missing
- Return *Off;
- EndIf;
-
- //No Issues - Valid Email Format
- Return *On;
-
- /End-Free
- PChrValEmail E
|
|