' whut: form Validation library 1.0
' desc: automates most basic form validation tasks, via custom attributes
' usage: see formValidation.html demo
' author: Rob Eberhardt, Slingshot Solutions, http://slingfive.com/
'
'<script language="vbscript">	'kicks in VID intellisense

' loops through form, checks each field with fnCheckRequiredField and fnCheckValidField, 
' raises err alerts if needed, returns overall validation status as boolean
FUNCTION fnValidateForm(oForm)
	DIM elem
	FOR EACH elem IN oForm.elements
		IF NOT fnCheckRequiredField(elem) THEN
			fnValidateForm = false
			EXIT FUNCTION
		ELSEIF NOT fnCheckMinLengthField(elem) THEN
			fnValidateForm = false
			EXIT FUNCTION
		ELSEIF NOT fnCheckValidField(elem) THEN
			fnValidateForm = false
			EXIT FUNCTION
		END IF
	NEXT
	fnValidateForm = true
END FUNCTION

' check if required field has any data
FUNCTION fnCheckRequiredField(oFld)
	IF oFld.getAttribute("required") THEN
		IF oFld.value = "" THEN 
			call subShowErrField(oFld, "")
			fnCheckRequiredField =false
			EXIT FUNCTION
		END IF
	END IF
	fnCheckRequiredField = true
END FUNCTION

' check if field's data meets or exceeds its minlength
FUNCTION fnCheckMinLengthField(oFld)
	iMinLength = oFld.getAttribute("minlength")
	IF isNumeric(iMinLength) THEN
		IF len(oFld.value) < cInt(iMinLength) THEN 
			call subShowErrField(oFld, vbCRLF & "(Enter at least " & iMinLength & " characters)")
			fnCheckMinLengthField =false
			EXIT FUNCTION
		END IF
	END IF
	fnCheckMinLengthField = true
END FUNCTION

'check if field's data matches its datatype
FUNCTION fnCheckValidField(oFld)
	DIM strFldDataType, bReturn, strMsgDetail
	strFldDataType = oFld.getAttribute("datatype")
	bReturn = true
	IF strFldDataType <> "" AND oFld.value <> "" THEN
		SELECT CASE lcase(strFldDataType)
			CASE "numeric":	bReturn = isNumeric(oFld.value)
			CASE "integer":	bReturn = isInteger(oFld.value)
			CASE "float":		bReturn = isFloat(oFld.value)
			CASE "date", "time", "datetime":		bReturn = isDate(oFld.value)
				IF bReturn AND oFld.type = "text" OR oFld.tagName = "textarea" THEN oFld.value = cDate(oFld.value)
			CASE "boolean":	bReturn = isBoolean(oFld.value)
				IF bReturn AND oFld.type = "text" OR oFld.tagName = "textarea" THEN oFld.value = cBool(oFld.value)

			CASE "email":		bReturn = isEmail(oFld.value)
				strMsgDetail = vbCRLF & "(in format 'UserName@DomainName.xxx')"
			CASE "phone":		bReturn = isPhone(oFld.value)
				strMsgDetail = vbCRLF & "(in format ###.###.####, or (###) ###-####)"
			CASE "ssn":			bReturn = isSSN(oFld.value)
				strMsgDetail = vbCRLF & "(in format ###-###-####)"
			CASE "zipcode":	bReturn = isZipCode(oFld.value)
		END SELECT
	END IF
	IF NOT bReturn THEN call subShowErrField(oFld, strMsgDetail)
	fnCheckValidField = bReturn
END FUNCTION


' raise error and explanation to user, highlight & focus field
SUB subShowErrField(oFld, strMsgDetail)
	DIM strElemHandle, strMsg
	strElemHandle = oFld.title
	IF strElemHandle = "" THEN strElemHandle = oFld.name
	IF strElemHandle = "" THEN strElemHandle = oFld.id
	oFld.runtimeStyle.backgroundColor="#f33"
	IF oFld.tagName = "SELECT" THEN
		strMsg = "Please make a valid selection for '" & strElemHandle & "'." & vbCRLF
	ELSE
		strMsg = "Please enter valid data for '" & strElemHandle & "'." & vbCRLF
	END IF
	call msgbox(strMsg & strMsgDetail, vbExclamation, "Validation Error")
	oFld.runtimeStyle.backgroundColor=""
	call window.setTimeout("document.all." & oFld.uniqueID & ".focus()", 0)
END SUB






'==== data-format check functions ====

FUNCTION isInteger(val)
	isInteger = isNumeric(val) AND instr(val, ".") = 0
END FUNCTION

FUNCTION isFloat(val)
	isFloat = isNumeric(val)
END FUNCTION

FUNCTION isBoolean(val)
	isBoolean = ((lcase(val) = "true" OR lcase(val) = "false") OR isNumeric(val))	
END FUNCTION

' hugely modified from code found at http://www.4guysfromrolla.com/webtech/051999-1.shtml
' checks validity of email address
FUNCTION isEmail(theAddress)
	isEmail = true
	DIM iAt, iLastDot
	iAt = inStr(theAddress, "@")
	iLastDot = inStrRev(theAddress, ".")
	'--- chk length; a@b.cd should be the shortest an address could be
	'--- chk format has at least one "@" (with something before it)
	'--- has Only one "@"
	'--- has at least one ".",  After the "@",  And with something between
	'--- has no more than 4 chars after last "." (like ".info")
	'--- has at least 2 chars after last "." (like ".us")
	IF len(theAddress) <6 _
		OR iAt < 2 _
		OR iAt <> inStrRev(theAddress, "@") _
		OR iLastDot-1 <= iAt _
		OR (len(theAddress) - iLastDot) > 4 _
		OR (len(theAddress) - iLastDot) < 2 THEN
		isEmail = false
	'--- has no "_" after the "@"
	ELSEIF inStr(theAddress, "_") <> 0 AND inStrRev(theAddress, "_") > inStrRev(theAddress, "@") THEN
		isEmail = false
	ELSE '--- chk validity of each char (alphanumeric, or these: "_.@-" )
		DIM curChar
		FOR i = 1 TO len(theAddress)
			curChar = mid(theAddress,i,1)
			IF NOT isNumeric(curChar) AND (lcase(curChar) < "a" OR lcase(curChar) > "z") AND _
				curChar <> "_" AND curChar <> "." AND curChar <> "@" AND curChar <> "-" THEN
					isEmail = false
			END IF
		NEXT
	END IF
END FUNCTION

FUNCTION isSSN(strTemp)
	'TODO: need validation logic here
	isSSN = true
END FUNCTION

FUNCTION isPhone(strTemp)
	'TODO: need validation logic here
	isPhone = true
END FUNCTION

FUNCTION isZipCode(strTemp)
	'TODO: need validation logic here
	IF strTemp = "" THEN EXIT FUNCTION
	isZipCode = (len(strTemp) = 5)
END FUNCTION