Validate email address in VB6

by Joe Hunter 17. September 2010 09:24

Nice little function for validating email addresses in VB6 by Brad Murray

Reference: http://www.freevbcode.com/ShowCode.Asp?ID=201

Function IsValidEmail(sEMail As String) As Boolean
    ' original by Brad Murray
    ' optimized by Rob Hofker, email: rob@eurocamp.nl,
     '23 august 2000
   
    Dim sInvalidChars As String
    Dim bTemp As Boolean
    Dim i As Integer
    Dim sTemp As String

    ' Disallowed characters
    sInvalidChars = "!#$%^&*()=+{}[]|\;:'/?>,< "

    ' Check that there is at least one '@'
    bTemp = InStr(sEMail, "@") <= 0
    If bTemp Then GoTo exit_function

    ' Check that there is at least one '.'
    bTemp = InStr(sEMail, ".") <= 0
    If bTemp Then GoTo exit_function

    ' and that the length is at least six (a@a.ca)
    bTemp = Len(sEMail) < 6
    If bTemp Then GoTo exit_function

    ' Check that there is only one '@'
    i = InStr(sEMail, "@")
    sTemp = Mid(sEMail, i + 1)
    bTemp = InStr(sTemp, "@") > 0
   
    If bTemp Then GoTo exit_function
    'extra checks
    ' AFTER '@' space is not allowed
    bTemp = InStr(sTemp, " ") > 0
    If bTemp Then GoTo exit_function

    ' Check that there is one dot AFTER '@'
    bTemp = InStr(sTemp, ".") = 0
    If bTemp Then GoTo exit_function
   
    ' Check if there's a quote (")
    bTemp = InStr(sEMail, Chr(34)) > 0
    If bTemp Then GoTo exit_function
   
       
    ' Check if there's any other disallowed chars
    ' optimize a little if sEmail longer than sInvalidChars
    ' check the other way around
    If Len(sEMail) > Len(sInvalidChars) Then
        For i = 1 To Len(sInvalidChars)
            If InStr(sEMail, Mid(sInvalidChars, i, 1)) > 0 _
                  Then bTemp = True
            If bTemp Then Exit For
        Next
    Else
        For i = 1 To Len(sEMail)
            If InStr(sInvalidChars, Mid(sEMail, i, 1)) > 0 _
                   Then bTemp = True
            If bTemp Then Exit For
        Next
    End If
    If bTemp Then GoTo exit_function
   
    ' extra check
    ' no two consecutive dots
    bTemp = InStr(sEMail, "..") > 0
    If bTemp Then GoTo exit_function
   
exit_function:
    ' if any of the above are true, invalid e-mail
    IsValidEmail = Not bTemp

End Function

Tags:

VB6

Powered by BlogEngine.NET 1.5.0.7
Theme by Mads Kristensen