Let me toss some code in… Some I wrote… Some I found. all could probably be optimized a bit
Function IsValidEMAIL(email as string) as Boolean
//=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'
' IsValidEmail( ) validates an email address As being in the CORRECT FORM (it does
' not actually check if the user mailbox exists). This validation used to be done using
' the RegEx, but it adds between 111KB to 229KB extra size for nothing gained if you
' do not use RegEx in your own application code.
'
' Dim rg As New RegEx
' rg.searchPattern="^[-\\w.]+@([A-z0-9][-A-z0-9]+\\.)+[A-z]{2,6}$"
' Return (rg.search(address) <> Nil)
'
' In addition, the above RegEx search pattern was extremely strict As in that international
' and special characters (which ARE valid) styled email addresses would always be rejected.
' The new code below will try to validate any RFC 3696 email address.
'
' Note: using the B type String functions when possible because they are much faster
'
//=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
winMAIN.inp_ICON_BTN(0).Enabled=false
ERROR_MESSAGE="Invalid Email Address"
//
If ( email.Len < 5 ) Then Return False // way to short
If ( email.Len > 256 ) Then Return False // too long
// email addresses must be in the format "mailbox@domain" so check if "@" first
If ( email.InStr( "@" )=0 ) Then Return False
// it is possible according to the RFC 822 to have more than one @ symbol in the email...
// the "mailbox" portion can have one but it needs to be quoted/escaped. An @ is NOT allowed
// in the "domain" part, so its easier to just check for the last @.
Dim elements( ) As String=email.Split("@")
Dim domain As String=elements.Pop // store last element as domain
Dim mailbox As String=Join(elements, "@") // recombine rest and put back any @ chars
If ( mailbox.Len < 1 ) Then Return False // empty mailbox Strings are invalid =)
If ( mailbox.Len > 64 ) Then Return False // mailbox length is too big
If ( domain.InStr( "." )=0 ) Then Return False // MUST have a least one "."
If ( mailbox.LeftB( 1 )="." ) Then Return False // "." cannot be first character in mailbox
If ( mailbox.RightB( 1 )="." ) Then Return False // "." cannot be last character in mailbox
If ( mailbox.InStrB( ".." ) > 0 ) Then Return False // cannot have 2 or more "." in a row
If ( domain.InStrB( ".." ) > 0 ) Then Return False // cannot have 2 or more "." in a row
Dim domainParts( ) As String=SplitB( domain, "." )
// if the last element of the domain is all numeric, then all elements must be (IP domain address)
Dim validateTypeIP As Boolean=IsNumeric( domainParts( domainParts.Ubound ))
// if not an IP address, than the last element of the domain must be at least 2 chars
If Not validateTypeIP And domainParts( domainParts.UBound ).Len < 2 Then Return False
For k As Integer=0 To domainParts.Ubound
Dim part As String=domainParts( k )
If ( part.LenB > 63 ) Then Return False // domain parts cannot be larger than 63 chars
If ( part.Len < 1 ) Then Return False // can't have empty Strings
If validateTypeIP Then
If Not IsNumeric( part ) Then Return False
Else
If ( part.LenB > 4 ) And part.LeftB( 4 )="xn--" Then
// allowable domain label that uses international characters (non-ascii)
Else
// if not international, then only can contain (a-z), (A-Z), (0-9) and "-" (if not first or last char)
// also switching to B type String compares (binary) for speed
Dim length As Integer=part.LenB
For x As Integer=1 To length
Select Case AscB( part.MidB( x, 1 ))
Case &h61 To &h7A, &h41 To &h5A, &h30 To &h39 // (a-z), (A-Z), (0-9)
// do nothing
Case &h2D // "-" character
If ( x=1 ) Or ( x=length ) Then Return False // hyphen can only be in middle
Else
Return False // invalid char for domain (non-international)
End Selec
Next
End If
End If
Next
// continue testing mailbox
Dim containsQuotedChars As Boolean=False
If ( mailbox.InStr( "\" ) > 0 ) Then
containsQuotedChars=True // contains at least one single quoted char (quote is \\ char)
Else
If ( mailbox.InStr( """" ) > 0 ) Then // there is at least one " char in there
Dim count As Integer=0
Dim start As Integer=-1
Do
start=mailbox.InStrB( start + 1, """" )
If ( start > 0 ) Then count=count + 1
Loop Until ( start=0 )
If (( count Mod 2 )=1 ) Then Return False // uneven pair of " chars
containsQuotedChars=True
End If
End If
// gonna ignore email addresses with quoted chars since its more complex (at least for now)
// and quoted mailbox types are more rare...
// RFC 3696: The quoted forms are rarely used in practice, but are required for some legitimate
// purposes. Hence, they should not be rejected in filtering routines but, should instead be
// passed to the email system for evaluation by the destination host.
If Not containsQuotedChars Then
Dim approvedList As String="abcdefghijklmnopqrstuvwxyz0123456789!#$%&'*+-/=?^_`.{\\}~"
// international (non-ascii) chars can be used, but we will ignore them
// also will be using NON-B versions of String formulas because of possible non-ascii chars
// also simplifies the "approvedList" since the compare will be case-insensitive
Dim length As Integer=mailbox.Len
Dim char As String
For x As Integer=1 To length
char=mailbox.Mid( x, 1 )
// char is ascii, but not in list so reject email
If ( Asc( char ) < 128 ) And ( approvedList.InStr( char )=0 ) Then Return False
Next
End If
// passed all the obstacles, so return true
winMAIN.inp_ICON_BTN(0).Enabled=true
Return True
END FUNCTION
FUNCTION IsValidFloat(byref num as string) as boolean
Dim s As String
s=Trim(ReplaceAll(num,",",""))
If Left(s,1)="+" Then s=Trim(Mid(s,2)) ' drop plus
If IsNumeric(s) Then
num=s
Return True
End If
Return False
END FUNCTION
FUNCTION IsValidInteger(byref num as string) as boolean
Dim x As Integer
Dim s As String
s=Trim(ReplaceAll(num,",",""))
x=InStr(s,".")
If x>0 Then Return False
If Left(s,1)="+" Then s=Trim(Mid(s,2)) ' drop plus
If IsNumeric(s) Then Return True
Return False
END FUNCTION
Function IsValidPhone(byref old_phone as string) as boolean ' US Phone Format!
Dim new_phone As String
new_phone=ReplaceAll(old_phone,"(","")
new_phone=ReplaceAll(new_phone,")","")
new_phone=ReplaceAll(new_phone,"-","")
new_phone=replaceall(new_phone," ","")
If (new_phone.Len<>7 And new_phone.Len<>10) Then Return false
If Not IsNumeric(new_phone) Then Return False
'
old_phone=new_phone
If old_phone.Len=10 Then old_phone="("+Left(old_phone,3)+") "+Mid(old_phone,4)
old_phone=Left(old_phone,Len(old_phone)-4)+"-"+Right(old_phone,4)
Return true
END FUNCTION
FUNCTION IsValidURL(URL as string) as boolean
Dim err_flag As Boolean
Dim i As Integer
Dim s As String
err_flag=False
If Left(url,7)="HTTP://" Then
url=Mid(url,8)
Elseif Left(url,8)="HTTPS://" Then
url=Mid(url,9)
End If
url=ReplaceAll(url,"\",".")
url=ReplaceAll(url,"/",".")
err_flag=(url.Len=0)
If Not err_flag Then
For i=1 To url.Len
Select Case Mid(url,i,1)
Case "A" To "Z","a" To "z","0" To "9","_","-",".","~"
Case "%" ' hex char
s="&H"+Mid(url,i+1,2)
If (Val(s)=0 And s<>"&H00") Then err_flag=True
Case Else
err_flag=True
End Select
If err_flag=True Then Exit For
Next i
End If
Return Not err_flag
END FUNCTION
