%
Function IsValidDocName(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsValidDocName = bAlphaStatus
End Function
Function IsValidSalaryField(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890() "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsValidSalaryField = bAlphaStatus
End Function
Function IsGradeDivision(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ+%.1234567890 "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsGradeDivision = bAlphaStatus
End Function
'*************************Working hours*********************
Function IsWorkingHours(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890()*/,. "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsWorkingHours = bAlphaStatus
End Function
'************************************************************************************
'This function return true if sText is AlphaNumeric otherwise return false
'************************************************************************************
Function IsValidFieldText(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-() "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsValidFieldText = bAlphaStatus
End Function
'**********************Issue********************************************
Function IsValidIssueName(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-(). "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsValidIssueName = bAlphaStatus
End Function
'************************************************************************************
'Employee Number
'************************************************************************************
Function IsEmployeeNumber(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890- "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsEmployeeNumber = bAlphaStatus
End Function
'***********************Ftaher Occupation*******************
Function IsFatherOccupation(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.() "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsFatherOccupation = bAlphaStatus
End Function
'************************************************************************************
'This function return true if sText is AlphaNumeric otherwise return false
'************************************************************************************
Function IsLogin(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ."
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsLogin = bAlphaStatus
End Function
'*************************************************************************************
Function IsClientName(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.-() "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsClientName = bAlphaStatus
End Function
'*******************************
'---------------------City,State,County------------------------------
Function IsCityStateCounty(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ. "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsCityStateCounty = bAlphaStatus
End Function
'*******************************
Function IsSalary(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.(),% "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsSalary = bAlphaStatus
End Function
'*******************************
'------------ZipCode---------------------------
'******************************
Function IsZipCode(sText) ' This function return true is sText is numeric otherwise return false
Dim str, nLen, bValid, ch
bValid = True
str = "0123456789"
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
if InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsZipCode = bValid
End Function
'***************************
Function IsValidGradeLevel(sText) ' This function return true is sText is numeric otherwise return false
Dim str, nLen, bValid, ch
bValid = True
str = "1234567"
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
if InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsValidGradeLevel = bValid
End Function
'---------------------Fax Number And UAN Number------------------
Function IsFaxUANNumber(sText) ' This function return true is sText is numeric otherwise return false
Dim str, nLen, bValid, ch
bValid = True
str = "0123456789+()- "
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
if InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsFaxUANNumber = bValid
End Function
'------------------------------------------------
'****************JOB TITLE*********************
Function IsJobTitle(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.()-,& "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsJobTitle = bAlphaStatus
End Function
'*******************************
'***********************DEGREE**************
Function IsQualification(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.()-,&0123456789 "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsQualification = bAlphaStatus
End Function
'*******************************************
'*********************end*********************
'**********First Name*********************
Function IsFirstName(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.()- "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsFirstName = bAlphaStatus
End Function
'*******************************
'********MIddle Name***********
Function IsMiddleName(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsMiddleName = bAlphaStatus
End Function
'************Last Name*******************
Function IsLastName(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.() "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsLastName = bAlphaStatus
End Function
'******************Blood Group*****************
Function IsBloodGroup(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ+- "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsBloodGroup = bAlphaStatus
End Function
'*******************************
'------------------Designation-----------------
Function IsDesignation(ByVal sText)
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.() "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsDesignation = bAlphaStatus
End Function
'-------Phone Number--------------------
Function IsPhoneNumber(sText) ' This function return true is sText is numeric otherwise return false
Dim str, nLen, bValid, ch
bValid = True
str = "0123456789+()-/ "
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
if InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsPhoneNumber = bValid
End Function
'-------------------Mobile NUmber---------------
Function IsMobileNumber(sText) ' This function return true is sText is numeric otherwise return false
Dim str, nLen, bValid, ch
bValid = True
str = "0123456789+- "
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
if InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsMobileNumber = bValid
End Function
'---------------------------------------------------------------------
'----------------allowing (",","0")------------------------
Function IsAmount(sText) ' This function return true is sText is numeric otherwise return false
Dim str, nLen, bValid, ch
bValid = True
str = "0123456789, "
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
if InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsAmount = bValid
End Function
'---------------------------------------------------------------------
'--------------------URL-----------------------------
'----------------------------------------------------
Function ValidURL( ByVal strURL )
strURL = Trim( strURL )
inx = Len( strURL ) : If inx > 7 Then inx = 7
If InStr( Left( strURL, 10 ), "::" ) > 0 Then strURL = Replace( strURL, "::", ":" )
If InStr( Left( strURL, 10 ), "//" ) < 1 Then strURL = Replace( Left( strURL, 7 ), "/", "//" ) & Right( strURL, Len( strURL ) - inx )
If Not( Left( LCase( strURL ), 7 ) = "http://" Or Left( LCase( strUrl ), 6 ) = "ftp://" ) Then
If Left( LCase( strUrl ), 3 ) = "ftp" Then
strURL = "ftp://" & strURL
Else
strURL = "http://" & strURL
End If
End If
strTmp = Replace( strURL, Chr(32), vbNullString )
strTmp = Mid( strTmp, InStr( strTmp, "//" ) + 2, Len( strTmp) )
pos = InStr( strTmp, "/" ) : If pos = 0 Then pos = Len( strTmp )
strTmp = Mid( strTmp, 1, pos )
If Len( Right( strTmp, Len( strTmp ) - InStrRev( strTmp, Chr(46) ) ) ) < 2 Or InStr( strTmp, Chr(46) ) < 2 Then
ValidURL = False
Else
ValidURL = strURL
End If
End Function
URL = Request.QueryString( "url" )
If Len( URL ) > 1 Then
Response.Write( URL & "
" & vbCrLf )
Response.Write( ValidURL( URL ) & "
" & vbCrLf )
End If
'------------------------------------------
Function IsValidDate(byVal sDate)
Dim bValid
sDate = Trim(sDate)
bValid = True
If IsDate(sDate) Then
If Month(sDate) < 1 OR Month(sDate) > 12 Then
Session("Date_Error") = "Please enter a valid Month"
bValid = Falses
IsValidDate = bValid
Exit Function
ElseIf Day(sDate) < 1 OR Day(sDate) > 31 Then
Session("Date_Error") = "Please enter a valid day"
bValid = False
IsValidDate = bValid
Exit Function
ElseIf Year(sDate) = 0 OR Year(sDate) < 1900 OR Year(sDate) > 2100 Then
Session("Date_Error") = "Please enter a valid year between 1900 and 2100"
bValid = False
IsValidDate = bValid
Exit Function
End If
Else
Session("Date_Error") = "Invalid Date Format"
bValid = False
End If
IsValidDate = bValid
End Function
'********************year*************************
Function IsValidYear(byVal sDate)
Dim bValid
'sDate = Trim(sDate)
CurrentYear=now
CurrentYear=Year(CurrentYear)
'old=Year(sDate)
bValid = True
'response.write sDate
'If Year(sDate) Then
'If sDate <> 0 OR sDate <> 1900 OR sDate <>= CurrentYear Then
If sDate = 0 OR sDate < 1900 OR sDate >= CurrentYear Then
Session("Year_Error") = "Please enter a valid year between 1900 and 2100"
bValid = False
IsValidYear = bValid
'response.write bValid
'response.End()
Exit Function
End If
IsValidYear = bValid
End Function
'************************************************************************************
Function IsCompareDate(startDate, endDate)
Dim bValid, nStartDay, nStartMonth, nStartYear
Dim nEndDay, nEndMonth, nEndYear
bValid = True
If datevalue(startDate) > datevalue(endDate) Then
bValid = False
End if
IsCompareDate = bValid
End Function
Function IsCompareDates(startDate, endDate)
Dim bValid, nStartDay, nStartMonth, nStartYear
Dim nEndDay, nEndMonth, nEndYear
bValid = True
if IsDate(startDate) and IsDate(endDate) then
If datevalue(startDate) >= datevalue(endDate) Then
bValid = False
End if
IsCompareDates = bValid
else
bValid = False
end if
End Function
Function IsGreaterDate(GDate)
Dim bValid, nStartDay, nStartMonth, nStartYear
Dim nEndDay, nEndMonth, nEndYear
dim startDate
startDate=date()
'GDate=date(GDate)
bValid = True
If GDate <> "" Then
If datevalue(startDate) > datevalue(GDate) Then
bValid = False
End if
End If
IsGreaterDate = bValid
End Function
Function IsEqualTodayDate(GDate)
Dim bValid, nStartDay, nStartMonth, nStartYear
Dim nEndDay, nEndMonth, nEndYear
dim startDate
startDate=date()
'GDate=date(GDate)
bValid = True
If datevalue(startDate) >= datevalue(GDate) Then
bValid = False
End if
IsEqualTodayDate = bValid
End Function
Function IslessDate(GDate)
Dim bValid, nStartDay, nStartMonth, nStartYear
Dim nEndDay, nEndMonth, nEndYear
dim startDate
startDate=date()
'response.write startDate
bValid = True
If datevalue(startDate) < datevalue(GDate) Then
bValid = False
End if
IslessDate = bValid
End Function
'************************************************************************************
'************************************************************************************
'************Created By Tauqeer November-06-2004***************
Function IsAlphaNumeric(ByVal sText) 'This function return true if sText is AlphaNumeric otherwise return false
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" & " "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsAlphaNumeric = bAlphaStatus
End Function
'**********************************
Function IsAlphaNumericSpecial(ByVal sText) 'This function return true if sText is AlphaNumeric otherwise return false
Dim nLen, nLoop, sTemp, sSingleCharacter
Dim bAlphaStatus
bAlphaStatus = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890,%" & " "
sTemp = Trim(sText)
nLen = Len(sTemp)
If nLen = 0 then
bAlphaStatus = False
End If
If nLen > 0 then
sTemp = Ucase(sTemp)
For nLoop =1 to nLen
sSingleCharacter = Mid(sTemp,nLoop,1)
If Instr(str, sSingleCharacter)= 0 then
bAlphaStatus = False
Exit For
End If
Next
If bAlphaStatus <> False then
bAlphaStatus = True
End If
End If
IsAlphaNumericSpecial = bAlphaStatus
End Function
'*********************
Function IsAlphabet(ByVal sText) 'This function return true is sText is Alphabet otherwise return falses
Dim str, bValid, nValid, ch
bValid = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
nLen = Len(sText)
sText = UCase(sText)
For i = 1 to nLen
ch = Mid(sText,i,1)
if InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsAlphabet = bValid
End Function
'***********************************
Function IsInstituteName(ByVal sText) 'This function return true is sText is Alphabet otherwise return falses
Dim str, bValid, nValid, ch
bValid = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & " " & "."
nLen = Len(sText)
sText = UCase(sText)
For i = 1 to nLen
ch = Mid(sText,i,1)
if InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsInstituteName = bValid
End Function
'------------------City------------------------
Function IsCityState(ByVal sText) 'This function return true is sText is Alphabet otherwise return falses
Dim str, bValid, nValid, ch
bValid = True
str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ()- "
nLen = Len(sText)
sText = UCase(sText)
For i = 1 to nLen
ch = Mid(sText,i,1)
if InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsCityState = bValid
End Function
'----------------------------------------------
'******************************
Function IsValidPhone(sText) ' This function return true is sText is numeric otherwise return false
Dim str, nLen, bValid, ch
bValid = True
str = "0123456789-+() "
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
if InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsValidPhone = bValid
End Function
'***************************
Function IsSpecialChar(sText) ' This function ture if thers is any special character(".`@'[]|()<>;/\\*&^%$#!\~+=:;,?{}") in sText otherwise return false
Dim bValid, str, nLen, ch
str = ".`@'[]|()<>;/\\*^%#!\~+=:;,?{}"
bValid = True
nLen = Len(sText)
For i = 1 to nLen
ch = Mid(sText,i,1)
If InStr(str,ch) <> 0 Then
bValid = True
Exit For
Else
bValid = False
End If
Next
IsSpecialChar = bValid
End Function
'*****************************
Function IsWhiteSpaces(sText) ' This function return true if there is whitespace in the in sText otherwise return false
Dim bValid, nLen,ch
bValid = True
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
If ch = " " Then
bValid = True
Exit For
Else
bValid = False
End If
Next
IsWhiteSpaces = bValid
End Function
'*********************************
Function IsValidTime(byVal sTime) ' This function validate the format and range of time and return true
Dim bValid
bValid = True
sTime = Trim(sTime)
If Not IsValidTimeFormat(sTime) Then
Session("Time_Error") = "Invalid Time Format"
bValid = False
IsValidTime = bValid
Exit Function
End If
If Not IsValidSecRange(sTime) Then
Session("Time_Error") = "Second must be between 1 and 59"
bValid = False
IsValidTime = bValid
Exit Function
End If
If Not IsValidMinRange(sTime) Then
Session("Time_Error") = "Minutes must be between 1 and 59"
bValid = False
IsValidTime = bValid
Exit Function
End If
If Not IsValidHourRange(sTime) Then
Session("Time_Error") = "Hours must be between 1 and 12"
bValid = False
IsValidTime = bValid
Exit Function
End If
IsValidTime = bValid
End Function
'************************************************************************************
Function IsValidTimeFormat(byVal sTime) ' this function return if the time is in valid format
Dim bValid
bValid = False
sTime = Trim(sTime)
nLenght = Len(sTime)
ch = Mid(sTime, nLenght-1, 2)
If ch = "AM" OR ch = "PM" OR ch = "am" OR ch = "pm" Then
If IsDate(sTime) Then
bValid = True
End If
End If
IsValidTimeFormat = bValid
End Function
'************************************************************************************
Function IsValidSecRange(byVal sTime) ' This function check the range of seconds in time and return true if range is valid
Dim bValid, Sec
bValid = True
If Second(sTime) < 0 OR Second(sTime) > 59 Then
bValid = False
End If
IsValidSecRange = bValid
End Function
'************************************************************************************
Function IsValidMinRange(byVal sTime) ' This function check the range of minutes in time and return true if range is valid
Dim bValid, Min
bValid = True
If Minute(sTime) < 0 OR Minute(sTime) > 59 Then
bValid = False
End If
IsValidMinRange = bValid
End Function
'************************
Function IsValidHourRange(byVal sTime) ' This function check the range of hours in time and return true if range is valid
Dim bValid, Hours
bValid = True
If Mid(sTime,1,inStr(sTime,":")-1) < 0 OR Mid(sTime,1,inStr(sTime,":")-1) > 12 Then
bValid = False
End If
IsValidHourRange = bValid
End Function
Function IsValidEmail(emailAddress)
Dim ValidEmail, emailParts, iLoopCounter, emailChar, acceptableChars
ValidEmail = True
acceptableChars="abcdefghijklmnopqrstuvwxyz.-_@"
emailParts = Split(emailAddress, "@")
If UBound(emailParts) <> 1 Then
ValidEmail = False
Else If Len(emailParts(0))<1 OR Len(emailParts(1))<4 Then
ValidEmail = False
End If
If Left(emailParts(0), 1)="." Then
ValidEmail = False
End If
If Right(emailParts(1), 1) = "." OR Right(emailParts(1), 2) = "." Then
ValidEmail = False
End If
If InStr(emailParts(1), ".") <= 0 Then
ValidEmail = False
End If
If InStr(emailParts(1), "_") > 0 Then
ValidEmail = False
End If
End If
For iLoopCounter = 1 to Len(emailAddress)
emailChar = Lcase(Mid(emailAddress, iLoopCounter, 1))
If InStr(acceptableChars, emailChar) = 0 and Not IsNumeric(emailChar) Then
ValidEmail = False
End If
Next
If InStr(emailAddress, "..") > 0 Then
ValidEmail = False
End If
If InStr(emailAddress, "@.") > 0 Then
ValidEmail = False
End If
IsValidEmail = ValidEmail
End Function
'*********************************
Function IsDoubleHyphen(sText)
Dim bValid, nLen, str
bValid = False
sText = Trim(sText)
nLen = Len(sText)
For i = 1 to nLen
str = Mid(sText,i,2)
If str = "--" Then
bValid = True
Exit For
End If
Next
IsDoubleHyphen = bValid
End Function
'********************************
'---- REPLACE FUNCTION FOR THE SINGLE QUOTE REPLACEMENT
Function fnReplace(strText)
If strText <> "" AND isNull(strText)=FALSE Then
strText=Replace(strText,"'","''")
End If
fnReplace=strText
End Function
'-------------------------------------------------------------------
'---- REPLACE FUNCTION FOR THE COMMA REPLACEMENT
Function fnReplaceCommaZero(strText)
If strText <> "" AND isNull(strText)=FALSE Then
strText=Replace(strText,",","")
End If
fnReplaceCommaZero=strText
End Function
'-------------------------------------------------------------------
'comma allowed in this function
Function IsNumericValue(sText) ' This function return true is sText is numeric otherwise return false
Dim str, nLen, bValid, ch
bValid = True
str = "0123456789, "
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
If InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsNumericValue = bValid
End Function
'******************NIC*************************
Function IsNIC(sText) ' This function return true is sText is numeric otherwise return false
Dim str, nLen, bValid, ch
bValid = True
str = "0123456789- "
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
If InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsNIC = bValid
End Function
'***************************
'comma not allowed for this function
Function IsNumericValueNoComma(sText) ' This function return true is sText is numeric otherwise return false
Dim str, nLen, bValid, ch
bValid = True
str = "0123456789"
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
If InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsNumericValueNoComma = bValid
End Function
Function IsNumericValueWithDot(sText) ' This function return true is sText is numeric otherwise return false
Dim str, nLen, bValid, ch
bValid = True
str = "0123456789."
nLen = Len(sText)
For j = 1 to nLen
ch = Mid(sText,j,1)
If InStr(str,ch) = 0 Then
bValid = False
Exit For
End If
Next
IsNumericValueWithDot = bValid
End Function
'***************************
Function amtWorkDays(start_date, end_date)
' GET WORK DAYS IN A WEEK
' DESCRIPTION: Take an interval start date and end date and return the amount of days inbetween taht are work days
' work days are customizable usin the VBSCRIPT Constant Numbers for Days of the Week.
'
' GET START OF INTERVAL
myworkstartdate = start_date
' GET END OF INTERVAL
myworkenddate = end_date
' CONVERT START/END TO DATES
myworkstartdate = CDate(myworkstartdate)
myworkenddate = CDate(myworkenddate)
' CREATE AND INITIALIZE THE TEMP TO BE TODAY'S DATE
mytempworkday = myworkstartdate
' COUNT WORK DAYS IN A WORK WEEK
' ITERATE THRU THE DAYS FROM TODAY TILL THE END OF THE INTERVAL AND COUNT THE
' DAYS EXCLUDING THE DAYS SEPCIFIED IN THE CASE STATEMENT BELOW. USING THE VBSCRIPT
' NUMERIC CONSTANT REPRESENTATION FOR DAYS
do until mytempworkday = myworkenddate
' GET THE CONSTANT REPRESENTATION OF TODAY
mydaycase = Weekday(mytempworkday)
select case mydaycase
' DAYS TO EXCLUDE
case 1,7
mytempworkday = DateAdd("D", 1, mytempworkday)
case else
' IF THE DAYS ARE NOT EXCLUDED INCREMENT THE WORK DAY COUNT
'response.write mytempworkday & "
"
mytempworkday = DateAdd("D", 1, mytempworkday)
amtWorkDays = amtWorkDays + 1
end select
loop
End Function
%>