Author : seenu
Date Submitted : 1/12/2005
Category : String Handling/Manipulation
Compatibility : VB 6
This code has been accessed 4953 times.
Task : Email validating - made easy
Declarations
Code
//paste this code and use it in your project
Private Sub cmdbutton_Click()
Dim str As String
Dim i As Integer
Dim pos1 As Integer
Dim pos2 As Integer
Dim diff As Integer
str = Trim(InputBox("Enter a mail id", "Email-Id"))
i = Len(str)
If i <> 0 Then
pos1 = InStr(1, str, "@")
pos2 = InStr(1, str, ".")
If pos1 <> 0 And pos2 <> 0 Then
If pos1 < pos2 Then
diff = pos2 - pos1
If diff = 1 Then
MsgBox "Invaid format", vbError + vbOKOnly, "Error"
Exit Sub
ElseIf pos2 = i Then
MsgBox "Invaid format", vbError + vbOKOnly, "Error"
Exit Sub
End If
If validate(str, i, pos1, pos2) = True Then
MsgBox "valid email-id", vbInformation + vbOKOnly, "valid id"
Exit Sub
Else
MsgBox "Invaid format", vbError + vbOKOnly, "Error"
Exit Sub
End If
Else
MsgBox "Invaid format", vbError + vbOKOnly, "Error"
Exit Sub
End If
Else
MsgBox "Invaid format", vbError + vbOKOnly, "Error"
Exit Sub
End If
End If
MsgBox "Enter a email-id", vbCritical + vbOKOnly, "emai-id"
End Sub
Private Function validate(str1 As String, ilen As Integer, ipos1 As Integer, ipos2 As Integer) As Boolean
validate = True
Dim fstr1 As String
Dim fstr2 As String
Dim fchr1 As String
Dim fstr3 As String
Dim fstr4 As String
Dim ascii As Integer
Dim ascii1 As Integer
Dim ascii2 As Integer
Dim ascii3 As Integer
Dim ascii4 As Integer
fstr1 = Mid(str1, ipos1 + 1, 1)
fstr2 = Mid(str1, ipos2 + 1, 1)
fchr1 = Mid(str1, 1, 1)
fstr3 = Mid(str1, ipos1 - 1, 1)
fstr4 = Mid(str1, ipos2 - 1, 1)
ascii = Asc(fchr1)
ascii1 = Asc(fstr1)
ascii2 = Asc(fstr2)
ascii3 = Asc(fstr3)
ascii4 = Asc(fstr4)
'check if the first character is '@'
If ipos1 = 1 Then
validate = False
Exit Function
End If
'check if the first character is '.'
If ipos2 = 1 Then
validate = False
Exit Function
End If
'check if the first character is an alphabhet
If Not (ascii >= 65 And ascii <= 122) Then
validate = False
Exit Function
End If
'check the previous character to the @
If Not (ascii3 >= 48 And ascii3 <= 122) Then
validate = False
Exit Function
End If
'check the previous character to the .
If Not (ascii4 >= 65 And ascii4 <= 122) Then
validate = False
Exit Function
End If
'check the next character to the @
If Not (ascii1 >= 65 And ascii1 <= 122) Then
validate = False
Exit Function
End If
'check the next character to the .
If Not (ascii2 >= 65 And ascii2 <= 122) Then
validate = False
Exit Function
End If
'check for the two subsequent '@'
If fstr1 = "@" Then
validate = False
Exit Function
End If
'checks for the two subsequent '.'
If fstr2 = "." Then
validate = False
Exit Function
End If
End Function