CheckEmail

Följande funktion skall användas för validering av epost-adresser som t.ex. knappats in i ett formulär.

Funktionen kan med fördel läggas i en seperat fil som inkluderas mha SSI.

Observera att koden nedan kan innehålla oavsiktliga radbrytningar!

<%
' Funktion för att validera emailadresser.
Public Function CheckEmail(emailString)

' Deklarationer.
Dim emailLength
Dim atNoCheck
Dim atPos
Dim lastDotPos
Dim emailCheck
Dim i

' Initieringar.
emailCheck = True

' Omvandlar emailsträngen till gemener.
emailString = LCase(emailString)

' Kollar längden på emailsträngen. Sparar längden.
emailLength = Len(emailString)
If emailLength \< 6 Then
	emailCheck = False
	CheckEmail = emailCheck
	Exit Function
End If

' Kontrollerar om det finns ETT "@" inom tillåtet 
' intervall i emailsträngen. Om så lagras positionen.
For i = 2 To emailLength - 4
	If Asc(Mid(emailString, i, 1)) = 64 Then
		atNoCheck = atNoCheck + 1
		atPos = i
	End If
Next
If atNoCheck \<\> 1 Then
	emailCheck = False
	CheckEmail = emailCheck
	Exit Function
End If

' Kontrollerar att tecknen till vänster om "@" är tillåtna tecken.
For i = 1 To atPos - 1
	If Asc(Mid(emailString, i, 1)) \< 97 Or Asc(Mid(emailString, i, 1)) \> 122 Then
		If Asc(Mid(emailString, i, 1)) \< 48 Or Asc(Mid(emailString, i, 1)) \> 57 Then
			If Not (Asc(Mid(emailString, i, 1)) = 45 Or Asc(Mid(emailString, i, 1)) = 46 Or Asc(Mid(emailString, i, 1)) = 95) Then
				emailCheck = False
				CheckEmail = emailCheck
				Exit Function
			End If
		End If
	End If
Next

' Kontrollerar att tecknet närmast till höger om "@" är alfanumeriskt eller "\_".
If Asc(Mid(emailString, atPos + 1, 1)) \< 97 Or Asc(Mid(emailString, atPos + 1, 1)) \> 122 Then
	If Asc(Mid(emailString, atPos + 1, 1)) \< 48 Or Asc(Mid(emailString, atPos + 1, 1)) \> 57 Then
		If Not Asc(Mid(emailString, atPos + 1, 1)) = 95 Then
			emailCheck = False
			CheckEmail = emailCheck
			Exit Function
		End If
	End If
End If

' Kontrollerar att resterande tecken till höger om "@" är tillåtna tecken.
For i = atPos + 2 To emailLength
	If Asc(Mid(emailString, i, 1)) \< 97 Or Asc(Mid(emailString, i, 1)) \> 122 Then
		If Asc(Mid(emailString, i, 1)) \< 48 Or Asc(Mid(emailString, i, 1)) \> 57 Then
			If Not (Asc(Mid(emailString, i, 1)) = 45 Or Asc(Mid(emailString, i, 1)) = 46 Or Asc(Mid(emailString, i, 1)) = 95) Then
				emailCheck = False
				CheckEmail = emailCheck
				Exit Function
			End If
		End If
	End If
Next

' Kontrollerar att det finns minst en punkt efter "@" samt att det inte 
' finns två eller fler punkter på rad. Sparar positionen för sista punkten.
For i = atPos + 2 To emailLength - 1
	If Asc(Mid(emailString, i, 1)) = 46 Then
		lastDotPos = i
		If Asc(Mid(emailString, i + 1, 1)) = 46 Then
			emailCheck = False
			CheckEmail = emailCheck
			Exit Function
		End If
	End If
Next
If lastDotPos = 0 Then
	emailCheck = False
	CheckEmail = emailCheck
	Exit Function
End If

' Kontrollerar att det finns två eller tre 
' tecken efter sista punkten.
If emailLength - lastDotPos \< 2 Or emailLength - lastDotPos \> 3 Then
	emailCheck = False
	CheckEmail = emailCheck
	Exit Function
End If

' Kontrollerar att tecknen efter sista punkten är alfanumeriska.
For i = lastDotPos + 1 To emailLength
	If Asc(Mid(emailString, i, 1)) \< 97 Or Asc(Mid(emailString, i, 1)) \> 122 Then
		If Asc(Mid(emailString, i, 1)) \< 48 Or Asc(Mid(emailString, i, 1)) \> 57 Then
			emailCheck = False
			CheckEmail = emailCheck
			Exit Function
		End If
	End If
Next

' Returnerar kontrollvärdet till anroparen.
CheckEmail = emailCheck

End Function
%>

Mvh Razor http://www.razorsedge.nu/

[Redigerat av Razor den 21 dec 2000]