📄 pop_datepicker.asp
字号:
<%Option Explicit%>
<%
Response.Write "<html>" & vbNewLine & _
"<head>" & vbNewLine & _
"<title>Choose Your Birthdate</title>" & vbNewLine & _
"<script language=""JavaScript"" type=""text/javascript"">" & vbNewLine & _
"// SET FORM FIELD VALUE TO THE DATE SELECTED" & vbNewLine & _
vbNewLine & _
"function ignore() {" & vbNewLine & _
" return true;" & vbNewLine & _
"}" & vbNewLine & _
"function returnDate(inDay) {" & vbNewLine & _
" window.onerror = ignore" & vbNewLine & _
" window.opener.document.forms['" & Request("FormName") & "']['" & Request("FieldName") & "'].value = inDay;" & vbNewLine & _
" self.close();" & vbNewLine & _
"}" & vbNewLine & _
"</script>" & vbNewLine
Rem -Get info from Application Variables
dim strCookieURL, strTimeAdjust, strForumTimeAdjust
strCookieURL = Left(Request.ServerVariables("Path_Info"), InstrRev(Request.ServerVariables("Path_Info"), "/"))
strTimeAdjust = Application(strCookieURL & "STRTIMEADJUST")
strForumTimeAdjust = DateAdd("h", strTimeAdjust , Date())
Rem -Color and Font vars
dim strDefaultFontFace,strDefaultFontSize,strHeaderFontSize,strFooterFontSize
dim strPageBGColor,strDefaultFontColor,strHeadCellColor,strHeadFontColor
dim strCategoryCellColor,strCategoryFontColor,strForumCellColor,strAltForumCellColor
dim strForumFontColor,strForumLinkColor,strForumLinkTextDecoration,strForumVisitedLinkColor
dim strForumVisitedTextDecoration,strForumActiveLinkColor,strForumActiveTextDecoration
dim strForumHoverFontColor,strForumHoverTextDecoration,strTableBorderColor,strHiLiteFontColor
dim strPageBGImageURL
strDefaultFontFace = Application(strCookieURL & "STRDEFAULTFONTFACE")
strDefaultFontSize = Application(strCookieURL & "STRDEFAULTFONTSIZE")
strHeaderFontSize = Application(strCookieURL & "STRHEADERFONTSIZE")
strFooterFontSize = Application(strCookieURL & "STRFOOTERFONTSIZE")
strPageBGColor = Application(strCookieURL & "STRPAGEBGCOLOR")
strDefaultFontColor = Application(strCookieURL & "STRDEFAULTFONTCOLOR")
strHeadCellColor = Application(strCookieURL & "STRHEADCELLCOLOR")
strHeadFontColor = Application(strCookieURL & "STRHEADFONTCOLOR")
strCategoryCellColor = Application(strCookieURL & "STRCATEGORYCELLCOLOR")
strCategoryFontColor = Application(strCookieURL & "STRCATEGORYFONTCOLOR")
strForumCellColor = Application(strCookieURL & "STRFORUMCELLCOLOR")
strAltForumCellColor = Application(strCookieURL & "STRALTFORUMCELLCOLOR")
strForumFontColor = Application(strCookieURL & "STRFORUMFONTCOLOR")
strForumLinkColor = Application(strCookieURL & "STRFORUMLINKCOLOR")
strForumLinkTextDecoration = Application(strCookieURL & "STRFORUMLINKTEXTDECORATION")
strForumVisitedLinkColor = Application(strCookieURL & "STRFORUMVISITEDLINKCOLOR")
strForumVisitedTextDecoration = Application(strCookieURL & "STRFORUMVISITEDTEXTDECORATION")
strForumActiveLinkColor = Application(strCookieURL & "STRFORUMACTIVELINKCOLOR")
strForumActiveTextDecoration = Application(strCookieURL & "STRFORUMACTIVETEXTDECORATION")
strForumHoverFontColor = Application(strCookieURL & "STRFORUMHOVERFONTCOLOR")
strForumHoverTextDecoration = Application(strCookieURL & "STRFORUMHOVERTEXTDECORATION")
strTableBorderColor = Application(strCookieURL & "STRTABLEBORDERCOLOR")
strHiLiteFontColor = Application(strCookieURL & "STRHILITEFONTCOLOR")
Response.Write "<style>" & vbNewLine & _
"<!--" & vbNewLine & _
".spnMessageText a:link {color:" & strForumLinkColor & ";text-decoration:" & strForumLinkTextDecoration & "}" & vbNewLine & _
".spnMessageText a:visited {color:" & strForumVisitedLinkColor & ";text-decoration:" & strForumVisitedTextDecoration & "}" & vbNewLine & _
".spnMessageText a:hover {color:" & strForumHoverFontColor & ";text-decoration:" & strForumHoverTextDecoration & "}" & vbNewLine & _
".spnMessageText a:active {color:" & strForumActiveLinkColor & ";text-decoration:" & strForumActiveTextDecoration & "}" & vbNewLine & _
"//-->" & vbNewLine & _
"</style>" & vbNewLine & _
"</head>" & vbNewLine & _
"<body background=""" & strPageBGImageURL & """ bgColor=""" & strPageBGColor & """ text=""" & strDefaultFontColor & """ topmargin=""3"" marginheight=""3"" marginwidth=""8"">" & vbNewLine
Rem -You can pass in a date... path/filename.asp?date=5/6/2003 It defaults to Todays date
Rem -To turn on a no select date after today pass in "History=on" in the url
Rem -Changed by Rakesh Jain(GauravBhabu)
function GetDaysInMonth(ByVal iMonth, ByVal iYear)
dim arrDaysInMonth
arrDaysInMonth = Array(31,28,31,30,31,30,31,31,30,31,30,31)
if isLeapYear(iYear) then arrDaysInMonth(1) = 29
GetDaysInMonth = arrDaysInMonth(iMonth -1)
end Function
Rem -This Procedure checks for leap year
Rem -Added by Rakesh Jain(GauravBhabu)
function IsLeapYear(ByVal intYear) 'As Integer) As Boolean
IsLeapYear = False
if (intYear Mod 100 = 0) then
if (intYear Mod 400 = 0) then IsLeapYear = True
elseif (intYear Mod 4 = 0) then
IsLeapYear = True
end if
end function
function GetWeekdayMonthStartsOn(ByVal dAnyDayInTheMonth)
dim dTemp
Rem -Deduct (Day Of Month - 1) from date to Get the date on first day of Month
dTemp = DateAdd("d", -(Day(dAnyDayInTheMonth) - 1), dAnyDayInTheMonth)
GetWeekdayMonthStartsOn = WeekDay(dTemp)
end function
Rem -Changed by Rakesh Jain(GauravBhabu)
function PreviousMonth(ByVal dDate)
dim dtePrevMonth
dtePrevMonth = DateAdd("m", -1, dDate)
PreviousMonth = dtePrevMonth
end function
Rem -Changed by Rakesh Jain(GauravBhabu)
function NextMonth(ByVal dDate)
dim dteNextMonth
dteNextMonth = DateAdd("m", 1, dDate)
if Month(dteNextMonth) > Month(strForumTimeAdjust) and Year(dteNextMonth) = Year(strForumTimeAdjust) then
dteNextMonth = strForumTimeAdjust
end if
NextMonth = dteNextMonth
end function
Rem -This procedure writes the days of month for the calendar
Rem -Added by Rakesh Jain(GauravBhabu)
sub WriteDayOfMonth(ByVal strDate, ByVal strClass, ByVal intDay, ByVal blnOnClick)
Dim strDayLink, strOnClick, strCellColor, strBoxTitle
strBoxTitle = ""
if blnOnClick then
strBoxTitle = FormatdateTime(dCell,vbLongdate)
strOnClick = " onclick=""" & strReturnFunc & """"
if strClass = "" then
strCellColor = strForumFontColor
strDayLink = "<a href=""javascript:" & strReturnFunc & """><font color=""" & strForumCellColor & """><b>" & intDay & "</b></font></a>"
else
strCellColor = strForumCellColor
strDayLink = "<span class=""" & strClass & """><a href=""javascript:" & strReturnFunc & """><b>" & intDay & "</b></a></span>"
end if
else
strCellColor = strAltForumCellColor
strDayLink = intDay
end if
Response.Write " <td title=""" & strBoxTitle & """ bgcolor=""" & strCellColor & """" & strOnClick & "><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & strDayLink & "<br /><br /></font></td>" & vbNewLine
end sub
function SetMonthSelection(i_intMonth)
if i_intMonth = Month(dDate) then
SetMonthSelection = (" selected")
end if
end function
sub SetYearSelection(i_intYear)
if i_intYear = Year(dDate) then
SetYearSelection = (" selected")
end if
end sub
Rem -Append zeros to the left of single digit Months and days
function doublenum(fNum)
if fNum > 9 then
doublenum = fNum
else
doublenum = "0" & fNum
end if
end function
function IsValidDate(strDOBDate)
dim intYear, intMonth, intDay
IsValidDate = false
if IsNumeric(strDOBDate) then
if len(strDOBDate) = 8 then
intYear = cLng(Left(strDOBDate,4))
intMonth = clng(Mid(strDOBDate,5,2))
intDay = cLng(Mid(strDOBDate,7,2))
if IsValidYear(intYear) then
if IsValidMonth(intMonth) then
if IsValidDay(intYear,intMonth,intDay) then IsValidDate = true
end if
end if
end if
end if
end function
function IsValidYear(ByVal intYear)
IsValidYear = false
if (intYear > 1900) and (intYear <= Year(Date)) then IsValidYear = true
end function
function IsValidMonth(ByVal intMonth)
IsValidMonth = false
if intMonth > 0 and intMonth < 13 then IsValidMonth = true
end function
function IsValidDay(ByVal intYear,ByVal intMonth,ByVal intDay)
dim arrDaysInMonth
arrDaysInMonth = Array(31,28,31,30,31,30,31,31,30,31,30,31)
IsValidDay = false
if IsLeapYear(intYear) then arrDaysInMonth(1) = 29
if (intDay) <= arrDaysInMonth(intMonth-1) then IsValidDay = true
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -