چطور حذف کردن ایمیل های نادرست (از نظر ساختار ایمیل) به صورت اتوماتیک از لیست باکس ؟

[maxtools]

چطور حذف کردن ایمیل های نادرست (از نظر ساختار ایمیل) به صورت اتوماتیک از لیست باکس ؟

[parselearn]

پويش و حذف كه توضيح داده شده

اعتبار سنجي:


Function ValidEmail(ByVal strCheck As String) As Boolean
'Created by Chad M. Kovac
'Tech Knowledgey, Inc.
'http://www.TechKnowledgeyInc.com

Dim bCK As Boolean
Dim strDomainType As String
Dim strDomainName As String
Const sInvalidChars As String = "!#$%^&*()=+{}[]|\;:'/?>,< "
Dim i As Integer

bCK = Not InStr(1, strCheck, Chr(34)) > 0 'Check to see if there is a double quote
If Not bCK Then GoTo ExitFunction

bCK = Not InStr(1, strCheck, "..") > 0 'Check to see if there are consecutive dots
If Not bCK Then GoTo ExitFunction

' Check for invalid characters.
If Len(strCheck) > Len(sInvalidChars) Then
For i = 1 To Len(sInvalidChars)
If InStr(strCheck, Mid(sInvalidChars, i, 1)) > 0 Then
bCK = False
GoTo ExitFunction
End If
Next
Else
For i = 1 To Len(strCheck)
If InStr(sInvalidChars, Mid(strCheck, i, 1)) > 0 Then
bCK = False
GoTo ExitFunction
End If
Next
End If

If InStr(1, strCheck, "@") > 1 Then 'Check for an @ symbol
bCK = Len(Left(strCheck, InStr(1, strCheck, "@") - 1)) > 0
Else
bCK = False
End If
If Not bCK Then GoTo ExitFunction

strCheck = Right(strCheck, Len(strCheck) - InStr(1, strCheck, "@"))
bCK = Not InStr(1, strCheck, "@") > 0 'Check to see if there are too many @'s
If Not bCK Then GoTo ExitFunction

strDomainType = Right(strCheck, Len(strCheck) - InStr(1, strCheck, "."))
bCK = Len(strDomainType) > 0 And InStr(1, strCheck, ".") < Len(strCheck)
If Not bCK Then GoTo ExitFunction

strCheck = Left(strCheck, Len(strCheck) - Len(strDomainType) - 1)
Do Until InStr(1, strCheck, ".") <= 1
If Len(strCheck) >= InStr(1, strCheck, ".") Then
strCheck = Left(strCheck, Len(strCheck) - (InStr(1, strCheck, ".") - 1))
Else
bCK = False
GoTo ExitFunction
End If
Loop
If strCheck = "." Or Len(strCheck) = 0 Then bCK = False

ExitFunction:
ValidEmail = bCK
End Function




http://www.bigresource.com/VB--Email-address-validation--HDeq3M1J.html
http://www.jack-frost.co.uk/vb6_email_address_validation.html
http://team.intellekt.ws/blogs/chris/archive/2005/01/18/523.aspx

[_behnam_]

برای اینکار از عبارات با قاعده هه میشه استفاده کرد که خیلی راحته
برای اینکه بتونید از عبارات با قاعده در VB6 استفاده کنید، باید از کتابخانه vbscript استفاده کنید. (از منوی Project، گزینه References رو انتخاب کنید و بعد از بین لیست dll ها گزینه Microsoft VBScript Regular Expressions 5.5 رو انتخاب کنید)



Public Function CheckEmail(ByVal Email As String) As Boolean
Dim collMatches As MatchCollection
Dim Regx As New RegExp
Set Regx = New RegExp
Regx.IgnoreCase = True
Regx.Pattern = "^([\w._])+@(yahoo|gmail).com$"
CheckEmail = Regx.Test(Email)
End Function