اين هم كد جاوا اسكريپت براي Email validation

کد:

---

Function isEmail(ByRef Invalue)
  Dim valueStr
  valueStr = trim(CStr(Invalue))
  If (Not(detectedEmailBadCharacters(valueStr))) Then
    If (Not(detectDoubleDotInARow(valueStr))) Then
      If (Not(detectDoubleAtSimbol(valueStr))) Then
        If (isUserNameOk(valueStr)) Then
          If (isExtensionOK(valueStr)) Then
            If (isHostNameOK(valueStr)) Then
              isEmail = True
            Else
              isEmail = False
            End If
          Else
            isEmail = False
          End If
        Else
          isEmail = False
        End If
      Else
        isEmail = False
      End If
    Else
      isEmail = False
    End If
  Else
    isEmail = False
  End If
End Function

Function detectedEmailBadCharacters(ByRef strInput)
  Dim bad_chars, foundOne, counter, strIn, i, ch, a, bad_char
  bad_chars = "!$%^""&*()+={[}]:;'~#<,>?/| "
  'string of Nasty characters to be checked for.
  foundOne = False
  counter = 5
  strIn = CStr(strInput)
  For i = 1 To Len(strIn)
    foundOne = False
    ch = mid(strIn,i,1)
    For a = 1 To Len(bad_chars)
      bad_char = mid(bad_chars,a,1)
      If(ch = bad_char)Then
        detectedEmailBadCharacters = True
        Exit Function
      End If 
    Next ' a
  Next ' i
  detectedEmailBadCharacters = False
End Function

Function isUserNameOk(strInput)
  Dim intIn
  intIn = InStr(strInput,"@")
  If intIn = 0 Then
    isUserNameOk = False
  Else 
    isUserNameOk = True
  End If
End Function

Function isHostNameOK(ByRef strInput)
  If InStr(strInput," ") <> 0 Then
    isHostNameOK = False
    Exit Function
  ElseIf InStr(strInput,"@") = 1 Then
    isHostNameOK = False
    Exit Function
  ElseIf InStr((Len(strInput)-1),strInput,"@") <> 0 Then
    isHostNameOK = False
    Exit Function
  ElseIf InStr((Len(strInput)-1),strInput,".") <> 0 Then
    isHostNameOK = False
    Exit Function
  ElseIf InStr((Len(strInput)-1),strInput,"_") <> 0 Then
    isHostNameOK = False
    Exit Function
  Else
    isHostNameOK = True
    Exit Function
  End If
End Function

Function detectDoubleDotInARow(strInput)
  Dim ch, last_is_a_dot, i
  ch = ""
  last_is_a_dot = False
  For i = 1 To Len(strInput)
    ch = mid(strInput,i,1)
    If((ch = ".") And (last_is_a_dot = False)) Then
      last_is_a_dot = True
    ElseIf ch <> "." Then
      last_is_a_dot = False
    ElseIf((ch = ".") And (last_is_a_dot = True)) Then
      detectDoubleDotInARow = True
      Exit Function
    End If
  Next
  detectDoubleDotInARow = False
End Function

Function detectDoubleAtSimbol(strInput)
  Dim ch, there_is_a_at_simbol, i
  ch = ""
  there_is_a_at_simbol = False
  For i = 1 To Len(strInput)
    ch = mid(strInput,i,1)
    If((ch = "@") And (there_is_a_at_simbol = False)) Then
      there_is_a_at_simbol = True
    ElseIf((ch = "@") And (there_is_a_at_simbol = True)) Then
      detectDoubleAtSimbol = True
      Exit Function
    End If 
  Next
  detectDoubleAtSimbol = False
End Function

Function isExtensionOK(strInput)
  Dim counter, there_is_a_dot, at_position, i, ch
  counter = 0
  there_is_a_dot = false
  at_position = InStr(1,strInput,"@")
  For i = (at_position + 1) To Len(strInput)
    ch = mid(strInput,i,1)
    counter = counter + 1
    If((ch = ".") And (counter = 1)) Then
      isExtensionOK = False
      Exit Function
    ElseIf((ch = ".") And (counter > 1)) Then
      isExtensionOK = True
      Exit Function
    End If
  Next
End Function

---