
Function IsEmail(ByRef asString)
	Dim lsDomain,lsSubDomain,lsSubDomainArray,lbIsIPdomainlnStart,lsUserName,lnOctect,lnOctect2,lnIndex
	const lsDOMAIN_CHARACTERS = ".ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-_"
	
	if Len(asString) < 6 Then IsEmail = False:Exit Function
	If Not InStr(asString, "@") > 1 Then IsEmail = False:Exit Function
	If Len(asString) = InStr(asString, "@") Then IsEmail = False:Exit Function
	
	lsDomain = UCase(Mid(asString, InStr(asString, "@") + 1))
	lsUserName = UCase(Left(asString, InStr(asString, "@") - 1))

	If InStr(lsDomain, ".") = 0 Then IsEmail = False:Exit Function
	
	lnStart = 1
	
	Do While lnStart <= Len(lsDomain)
		If InStr(lsDOMAIN_CHARACTERS, Mid(lsDomain, lnStart, 1)) Then
			lnStart = lnStart + 1
		Else
			IsEmail = False
			Exit Function
		End If
	Loop
	
	lsSubDomainArray = Split(lsDomain, ".")
	lbIsIPdomain = False

	For lnIndex = 0 To UBound(lsSubDomainArray, 1)
		lsSubDomain = lsSubDomainArray(lnIndex)
		
		If Len(lsSubDomain) = 0 Then IsEmail = False:Exit Function
		If lnIndex = 0 Then
			If IsNumeric(lsSubDomain) Then
				lbIsIPDomain = True
				If Not UBound(lsSubDomainArray, 1) = 3 Then	IsEmail = False:Exit Function
			End If
		End If

		If lbIsIPDomain Then
			If Len(lsSubDomain) > 3 Then
				IsEmail = False
				Exit Function
			ElseIf Not InStr(lsSubDomain, "-") = 0 Then
				IsEmail = False
				Exit Function
			ElseIf Not IsNumeric(lsSubDomain)Then
				IsEmail = False
				Exit Function
			End If

			lnOctect = CInt(lsSubDomain)
		
			If lnOctect > 255 Then
				IsEmail = False
				Exit Function
			ElseIf lnOctect < 0 Then
				IsEmail = False
				Exit Function
			End If

			If lnIndex = 0 Then
				lnOctect2 = lsSubDomainArray(1)
					If Len(lnOctect2) > 3 Then
						IsEmail = False
						Exit Function
					ElseIf Not IsNumeric(lnOctect2)Then
						IsEmail = False
						Exit Function
					End If
				lnOctect2 = CInt(lnOctect2)
			
				Select Case lnOctect
					Case 10
						IsEmail = False
						exit Function
					Case 172
						If lnOctect2 => 16 And lnOctect2 =< 31 Then
							IsEmail = False
							Exit Function
						End If
					Case 192 ' Local Network
						If lnOctect2 = 168 Then
							IsEmail = False
							Exit Function
						End If
					Case 127 ' Local Machine
						IsEmail = False
						Exit Function				
				end Select
			End If
		Else
			If lnIndex = UBound(lsSubDomainArray, 1) Then
				If Len(lsSubDomain) > 3 Then
					IsEmail = False
					Exit Function
				ElseIf Not InStr(lsSubDomain, "-") = 0 Then
					IsEmail = False
					Exit Function
				End If
			Else
				If Len(lsSubDomain) > 22 Then
					IsEmail = False
					Exit Function
				End If
			End If
		End If
	Next

	lnStart = 1

	Do While lnStart <= Len(lsUserName)
		If InStr(lsDOMAIN_CHARACTERS, Mid(lsUserName, lnStart, 1)) Then
			lnStart = lnStart + 1
		Else
			IsEmail = False
			Exit Function
		End If
	Loop

	IsEmail = True
End Function

sub mailok_onclick
window.navigate("http://www.sptechs.com")
   
end sub 

sub nomail_onclick
window.navigate.back 
end sub 



sub doemail_onclick
	 
	submitform
end sub
  
 
  sub submitform
	dim fmail,tmail,esubject,ebody
	fmail=document.forms ("send").item ("fromemail").value
	tmail=document.forms ("send").item ("toemail").value
	esubject=document.forms ("send").item ("subject").value
	ebody=document.forms ("send").item ("body").value
	 

 if tmail ="" then window.alert"رجاء اكتب ايميل المرسل إليه " : exit sub 
 
	 if fmail <>"" then 
	if not isemail(fmail)  then window.alert ("عنوانك غير صحيح "):exit sub
	end if 
	  if tmail <>"" then 
	if not isemail(tmail)  then window.alert ("عنوان المرسل إليه غير صحيح "):exit sub
	end if
             if len(esubject)>30 then  window.alert(" الموضوع طويل جدا " ): exit sub 
	if len (ebody) > 90 then window.alert (" نص الرسالة طويل جدا " ) : exit sub 
              
	send.submit
end sub



Function bval(ByRef xstr )

bval = val(xstr) 

end function 




