---
title: "CheckEmail"
type: "forum-thread"
url: "https://www.webforum.nu/amne/asp/38114-checkemail"
topic: "ASP"
topic_url: "https://www.webforum.nu/amne/asp"
author: "Razor"
published: "2000-12-21T14:25:00.000Z"
updated: "2000-12-21T14:25:00.000Z"
replies: 0
views: 913
page: 1
pages: 1
language: "sv-SE"
site: "webForum — webforum.nu"
rights: "Upphovsrätten till varje inlägg tillhör dess författare."
attribution: "Citera som: webForum, https://www.webforum.nu/amne/asp/38114-checkemail"
---

# CheckEmail

## #1 — Razor, 2000-12-21T14:25Z

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\]

Permalänk: https://www.webforum.nu/p/38114

---

Tråden på webben: https://www.webforum.nu/amne/asp/38114-checkemail