added sysprog entities
This commit is contained in:
Infineon\StieberD
235
SYSPROG/STPROC/EMAIL_FORMAT.txt
Normal file
235
SYSPROG/STPROC/EMAIL_FORMAT.txt
Normal file
@ -0,0 +1,235 @@
|
||||
compile Subroutine EMAIL_FORMAT( charstr CONV, charstr ANS, charstr BRANCH, charstr RETURN_DATA)
|
||||
*
|
||||
* EMAIL_FORMAT is an example of a developer's custom prompt formatting
|
||||
* routine using the square brackets call.
|
||||
*
|
||||
* It should be placed in square brackets, like this:
|
||||
*
|
||||
* [EMAIL_FORMAT]
|
||||
*
|
||||
* This subroutine should be used as the first and only "Input Validation" in
|
||||
* a window prompt. Placed in "Output Format", it properly checks that
|
||||
* the string passed in is a valid Email address
|
||||
*
|
||||
!
|
||||
* MrC 3-23-21 Remove 3d Gray color from message and added icon
|
||||
* mtr 5-31-11 Changes subdomain to allow first chars to be numbers
|
||||
|
||||
* Subroutine declarations
|
||||
|
||||
$insert msg_equates
|
||||
declare function msg
|
||||
|
||||
* Local Equates
|
||||
* The STATUS() variable is used to indicated the error condition of the
|
||||
* pattern. They are:
|
||||
EQU VALID$ TO 0 ;* Successful
|
||||
EQU INVALID_MSG$ TO 1 ;* Bad Data - Print error message window
|
||||
EQU INVALID_CONV$ TO 2 ;* Bad Conversion - " "
|
||||
EQU INVALID_NOMSG$ TO 3 ;* Bad but do not print the error message window
|
||||
|
||||
EQU THREEDGRAY$ TO 192
|
||||
|
||||
* Begin Conversion
|
||||
*
|
||||
RETURN_DATA = ""
|
||||
|
||||
IF ANS NE "" THEN
|
||||
EMAIL = ANS
|
||||
ANS = ""
|
||||
|
||||
* mtr 1-19-07
|
||||
email = trim(Email)
|
||||
|
||||
STATUS() = VALID$
|
||||
|
||||
IF LEN( EMAIL ) THEN
|
||||
* Case statement to validate all possible types of Social Security numbers. If
|
||||
* a new format is required simply add another case.
|
||||
* The fall-through (CASE 1) traps invalid conversions.
|
||||
BEGIN CASE
|
||||
Case email
|
||||
error_flag = ''
|
||||
return_data = ''
|
||||
* per RFC #822 <http://www.isi.edu/in-notes/rfc822.txt>
|
||||
// Valid characters in an "atom"
|
||||
exclude_atom = '()<>@,:;\?".[]':char(27)
|
||||
exclude_quoted = '"\':char(13)
|
||||
atom_chars = ''; *[#33..#255] - ['(', ')', '<', '>', '@', ',', ';', ':', '\', '/', '"', '.', '[', ']', #127]
|
||||
quoted_string_chars = '';* [#0..#255] - ['"', #13, '\']
|
||||
For i = 0 To 255
|
||||
this_char = char(i)
|
||||
If Index(exclude_atom, this_char, 1) ELSE
|
||||
If i >=33 then
|
||||
atom_chars:=this_char
|
||||
end
|
||||
end
|
||||
If Index(exclude_quoted, this_char, 1) ELSE
|
||||
quoted_string_chars:=this_char
|
||||
end
|
||||
Next i
|
||||
|
||||
// Valid characters in a subdomain
|
||||
letters = @upper.Case:@lower.case
|
||||
letters_digits = letters:'0123456789'
|
||||
subdomain_chars = '-':letters_digits
|
||||
STATE_BEGIN = 1
|
||||
STATE_ATOM = 2
|
||||
STATE_QTEXT = 3
|
||||
STATE_QCHAR = 4
|
||||
STATE_QUOTE = 5
|
||||
STATE_LOCAL_PERIOD = 6
|
||||
STATE_EXPECTING_SUBDOMAIN= 7
|
||||
STATE_SUBDOMAIN = 8
|
||||
STATE_HYPHEN = 9
|
||||
|
||||
|
||||
State = STATE_BEGIN
|
||||
n = Len(email)
|
||||
i = 1
|
||||
subdomains = 1
|
||||
for i = 1 To n
|
||||
this_char = email[i, 1]
|
||||
Begin case
|
||||
Case State = STATE_BEGIN
|
||||
if index(atom_chars, this_char, 1) then
|
||||
State = STATE_ATOM
|
||||
End else
|
||||
if this_char = '"' then
|
||||
State = STATE_QTEXT
|
||||
End else
|
||||
error_flag = 1
|
||||
end
|
||||
end
|
||||
|
||||
Case State = STATE_ATOM
|
||||
if this_char = '@' then
|
||||
State = STATE_EXPECTING_SUBDOMAIN
|
||||
End else
|
||||
if this_char = '.' then
|
||||
State = STATE_LOCAL_PERIOD
|
||||
End else
|
||||
if index(atom_chars, this_char, 1) else
|
||||
error_flag = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
Case State = STATE_QTEXT
|
||||
if this_char = '\' then
|
||||
State = STATE_QCHAR
|
||||
End else
|
||||
if this_char = '"' then
|
||||
State := STATE_QUOTE
|
||||
End else
|
||||
if Index(quoted_string_chars, this_char, 1) else
|
||||
error_flag = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
Case State = STATE_QCHAR
|
||||
State = STATE_QTEXT
|
||||
|
||||
Case State = STATE_QUOTE
|
||||
if this_char = '@' then
|
||||
State = STATE_EXPECTING_SUBDOMAIN
|
||||
End else
|
||||
if this_char = '.' then
|
||||
State = STATE_LOCAL_PERIOD
|
||||
End else
|
||||
error_flag = 1
|
||||
end
|
||||
end
|
||||
|
||||
Case State = STATE_LOCAL_PERIOD
|
||||
if index(atom_chars, this_char, 1) then
|
||||
State = STATE_ATOM
|
||||
End else
|
||||
if this_char = '"' then
|
||||
State = STATE_QTEXT
|
||||
End else
|
||||
error_flag = 1
|
||||
end
|
||||
end
|
||||
|
||||
Case State = STATE_EXPECTING_SUBDOMAIN
|
||||
* mtr 5-31-11
|
||||
*If Index(letters, this_char, 1) Then
|
||||
If Index(letters_digits, this_char, 1) then
|
||||
State = STATE_SUBDOMAIN
|
||||
end else
|
||||
error_flag = 1
|
||||
end
|
||||
|
||||
Case State = STATE_SUBDOMAIN
|
||||
if this_char = '.' then
|
||||
subdomains += 1
|
||||
State = STATE_EXPECTING_SUBDOMAIN
|
||||
end else
|
||||
if this_char = '-' then
|
||||
State = STATE_HYPHEN
|
||||
end else
|
||||
if index(letters_digits, this_char, 1) else
|
||||
error_flag = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
Case State = STATE_HYPHEN
|
||||
if Index(letters_digits, this_char, 1) then
|
||||
State = STATE_SUBDOMAIN
|
||||
End else
|
||||
if this_char # '-' then
|
||||
error_flag = 1
|
||||
end
|
||||
end
|
||||
|
||||
|
||||
End case
|
||||
|
||||
next i
|
||||
|
||||
If error_flag then
|
||||
Gosub DisplayError
|
||||
STATUS() = INVALID_NOMSG$
|
||||
end else
|
||||
GoodEmail = (State = STATE_SUBDOMAIN) and (subdomains >= 2)
|
||||
If GoodEmail then
|
||||
return_data = email
|
||||
End else
|
||||
Gosub DisplayError
|
||||
STATUS() = INVALID_NOMSG$
|
||||
end
|
||||
end
|
||||
|
||||
|
||||
|
||||
CASE 1
|
||||
IF CONV = "ICONV" THEN
|
||||
gosub DisplayError
|
||||
END
|
||||
STATUS() = INVALID_NOMSG$
|
||||
END CASE
|
||||
END ELSE
|
||||
IF CONV = "ICONV" THEN
|
||||
gosub DisplayError
|
||||
END
|
||||
STATUS() = INVALID_NOMSG$
|
||||
END
|
||||
end
|
||||
|
||||
RETURN
|
||||
|
||||
DisplayError:
|
||||
msgrec = ""
|
||||
msgrec<MCAPTION$> = "Data Validation Error"
|
||||
msgrec<MTEXT$> = EMAIL : " is not a valid email address.||Please enter a email address with a name,|an '@' symbol, and a server/domain."
|
||||
// msgrec<MBKCOLOR$> = THREEDGRAY$:@VM:THREEDGRAY$:@VM:THREEDGRAY$
|
||||
msgrec<MJUST$> = 'C'
|
||||
msgRec<MICON$> = "!"
|
||||
result = msg( "", msgrec)
|
||||
Return
|
||||
|
||||
* Source Date: 13:55:58 17 SEP 2004 Build ID: OI*7.1 Level: 7.1
|
||||
|
||||
Reference in New Issue
Block a user