%@ LANGUAGE=VBSCRIPT %>
<%Option Explicit%>
<%
response.buffer=true
Response.Expires = 0
%>
<%
BBID = "1"
'BBID = request.querystring("bbid")
'If BBID = "" Then
'Response.Redirect "default.htm"
'End If
Dim dDate ' Start date we're displaying calendar for
Dim iCurrent ' Variable we use to hold current day of month as we write table
Dim iPosition ' Variable we use to hold current position in table
dim BBID
dim counter
dim temp
Dim iCurrent2
Dim iPosition2
dim BasicErrStr
dim imonth
dim iday
dim iyear
dim submit
dim twoweeks
dim daycolor
dim rs
dim sql
dim rs2
dim sql2
dim roomid
dim roomdate ()
redim roomdate (0)
dim resrequest
dim reservation
dim i3
dim check2
dim clear
dim rs4
dim sql4
submit = request("submit")
twoweeks = request("twoweeks")
ddate = request("ddate")
imonth = request("imonth")
iday = request("iday")
iyear = request("iyear")
resrequest = request("resrequest")
reservation = request("reservation")
clear = request("clear")
if submit = "Look It Up" then
imonth = request("imonth")
iday = request("iday")
iyear = request("iyear")
If IsDate(Request("imonth") & "-" & Request("iday") & "-" & Request("iyear")) Then
dDate = CDate(Request("imonth") & "-" & Request("iday") & "-" & Request("iyear"))
Else
ddate = date()
BasicErrStr = "The date you picked was not a valid date. The calendar was set to today's date. "
End If
submit = 0
if ddate < date() then
ddate = date()
BasicErrStr = "The date you picked was before today's date. The calendar was set to today's date. "
imonth = month(ddate)
iday = day(ddate)
iyear = year(ddate)
end if
else
if twoweeks = "<<" then
if DateAdd("d",-28,ddate) < date() then
ddate = date()
BasicErrStr = "The date you picked was before today's date. The calendar was set to today's date. "
imonth = month(ddate)
iday = day(ddate)
iyear = year(ddate)
twoweeks = 0
else
ddate = DateAdd("d",-28,ddate)
imonth = month(ddate)
iday = day(ddate)
iyear = year(ddate)
twoweeks = 0
end if
elseif twoweeks = ">>" then
ddate = DateAdd("d",28,ddate)
imonth = month(ddate)
iday = day(ddate)
iyear = year(ddate)
twoweeks = 0
else
ddate = date()
imonth = month(date())
iday = day(date())
iyear = year(date())
end if
End If
iPosition = 1
iCurrent = ddate
iPosition2 = 1
iCurrent2 = ddate
Dim Conn
Set Conn = CreateObject("ADODB.Connection")
Conn.Open DataSource1
'Dim objRec
Set RS2 = CreateObject("ADODB.Recordset")
'/////////////////////////////////////////
sql2 = "Select * FROM tBB_Room WHERE tBB_Room.BBID = " & BBID & " order by Name"
set rs2=Conn.execute(sql2)
dim rs3
dim sql3
sql3 = "Select * FROM tBB WHERE tBB.BBID = " & BBID & ""
set rs3=Conn.execute(sql3)
If Not rs3.EOF Then
sub showdateform(mylistname)
call showmonth(mylistname)
call showday(mylistname)
call showyear(mylistname)
end sub
sub showmonth(listname)%>
<%
end sub
sub showday(listname)%>
<%
end sub
sub showyear(listname)%>
<%
end sub
Function GetWeekdayAbv(datein)
dim wday
wday = Weekday(datein)
dim abv
if wday = 1 then abv = "Sun"
if wday = 2 then abv = "Mon"
if wday = 3 then abv = "Tue"
if wday = 4 then abv = "Wed"
if wday = 5 then abv = "Thu"
if wday = 6 then abv = "Fri"
if wday = 7 then abv = "Sat"
GetWeekdayabv = abv
End Function
sub tableheading ()
'-- Write days of month in proper day slots --
Do While iPosition <= 28
'-- Write headings --
if weekday(iCurrent)=1 or weekday(iCurrent)=7 then
daycolor = " bgcolor=#eeeeee "
else
daycolor = ""
end if
Response.Write(vbTab & vbTab & "
" & vbCrLf)
'-- Close the table row --
If iPosition = 28 Then
Response.Write vbTab & "" & vbCrLf
'iPosition = 0
End If
'-- Increment variables --
iCurrent = DateAdd("d",1,iCurrent)
iPosition = iPosition + 1
Loop
end sub
sub tablerows ()
Do Until rs2.eof
sql = "Select * FROM tavailability WHERE tavailability.RoomID = " & rs2("RoomID") & ""
set rs=Conn.execute(sql)
sql4 = "Select * FROM tpending WHERE tpending.RoomID = " & rs2("RoomID") & ""
set rs4=Conn.execute(sql4)
Response.Write""
Do While iPosition2 <= 28
'-- open the table row and write the Room--
'If iPosition2 = 1 Then
'roomid = rs2("roomid")
'Response.Write(vbTab & "
" & vbCrLf)
' if len(rs2("roomlink"))>0 then
' Response.Write(vbTab & vbTab & "
")
'end if
'End If
'-- Check the db, create and populate checkboxes --
if weekday(iCurrent2)=1 or weekday(iCurrent2)=7 then
daycolor = " bgcolor=#eeeeee "
else
daycolor = ""
end if
if not rs4.eof then
rs4.movefirst
do while not rs4.eof
if rs4("pending") = iCurrent2 then
daycolor = " bgcolor=#ffff66 "
end if
rs4.movenext
loop
rs4.movefirst
end if
Response.Write(vbTab & vbTab & "
")
If Not rs.eof Then 'check for any records with same RoomID
Do Until rs.eof
if rs("datebooked") = iCurrent2 then 'check for current date
Response.Write ("")
exit Do
end if
rs.MoveNext
if rs.eof then
check2=0
for i3 = lbound(runningarray) to ubound(runningarray)
if runningarray(i3) = roomid & "=" & iCurrent2 then
check2 = 1
end if
next
'if check2 = 1 then
'Response.Write ("")
'else
'Response.Write ("")
'end if
response.write ("")
if Ubound(roomdate)=0 then
ReDim Preserve roomdate(Ubound(roomdate) + 1)
roomdate(1) = roomid & "=" & iCurrent2
else
ReDim Preserve roomdate(Ubound(roomdate) + 1)
roomdate(Ubound(roomdate))= roomid & "=" & iCurrent2
end if
end if
Loop
rs.movefirst
else 'no booking that day for that RoomID
check2=0
for i3 = lbound(runningarray) to ubound(runningarray)
if runningarray(i3) = roomid & "=" & iCurrent2 then
check2 = 1
end if
next
if check2 = 1 then
Response.Write ("")
else
Response.Write ("")
end if
if Ubound(roomdate)=0 then
ReDim Preserve roomdate(Ubound(roomdate) + 1)
roomdate(1) = roomid & "=" & iCurrent2
else
ReDim Preserve roomdate(Ubound(roomdate) + 1)
roomdate(Ubound(roomdate))= roomid & "=" & iCurrent2
end if
end if
Response.Write("
" & vbCrLf)
'-- Close the table row --
If iPosition2 = 28 Then
Response.Write vbTab & "
" & vbCrLf
End If
'-- Increment variables --
iCurrent2 = DateAdd("d",1,iCurrent2)
iPosition2 = iPosition2 + 1
Loop
iCurrent2 = ddate
iPosition2 = 1
Response.Write""
rs.close
set rs = nothing
rs2.movenext
Loop
end sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'this section to hold checkmarks as user moves from page to page
dim executestr
dim check
dim strdatesrequested
dim adatesrequested
dim iLoop
dim strrunningdates
dim arunningdates
dim runningarray ()
redim runningarray (0)
dim i4
dim check3
dim i5
dim i6
strdatesrequested = request("datesrequested") 'comma delimited string of dates from hidden fields on prior page
adatesrequested = split(strdatesrequested, ",") 'array we create
strrunningdates = request("runningdates")
arunningdates = split(strrunningdates, ",") 'running array we need to hold checkmarks from one page to another
if len(strrunningdates)>0 then
For iLoop = LBound(arunningdates) to UBound(arunningdates) 'taking spaces out of array that occured from the comma delimited string
arunningdates(iLoop) = Trim(arunningdates(iLoop))
Next
For iLoop = LBound(arunningdates) to UBound(arunningdates)
check3=0
for i4=lbound(runningarray) to ubound(runningarray)
if runningarray(i4) = arunningdates(iLoop) then
check3 = 1
end if
next
if check3 = 0 then
if Ubound(runningarray)=0 then
ReDim Preserve runningarray(Ubound(runningarray) + 1)
runningarray(1) = arunningdates(iLoop)
else
ReDim Preserve runningarray(Ubound(runningarray) + 1)
runningarray(Ubound(runningarray))= arunningdates(iLoop)
end if
end if
Next
end if
For iLoop = LBound(adatesrequested) to UBound(adatesrequested) 'taking spaces out of array that occured from the comma delimited string
adatesrequested(iLoop) = Trim(adatesrequested(iLoop))
Next
For iLoop = LBound(adatesrequested) to UBound(adatesrequested) 'checking value of checkbox
executestr = "if (request(""" & adatesrequested(iLoop) & """)) = ""on"" then check =""on"""
execute (executestr)
if check = "on" then 'add to array
check3=0
for i4=lbound(runningarray) to ubound(runningarray)
if runningarray(i4) = adatesrequested(iLoop) then
check3 = 1
end if
next
if check3 = 0 then
if Ubound(runningarray)=0 then
ReDim Preserve runningarray(Ubound(runningarray) + 1)
runningarray(1) = adatesrequested(iLoop)
else
ReDim Preserve runningarray(Ubound(runningarray) + 1)
runningarray(Ubound(runningarray))= adatesrequested(iLoop)
end if
end if
check = ""
else
for i5=lbound(runningarray) to ubound(runningarray) 'check to see if (possibly now) non-selection is already in running array
if runningarray(i5) = adatesrequested(iLoop) then 'is already in running array but has been de-selected
for i6 = (i5) to ubound(runningarray) - 1
runningarray(i6) = runningarray(i6 + 1)
next
ReDim Preserve runningarray(Ubound(runningarray) - 1)
exit for
end if
next
end if
Next
if reservation = "Make a Reservation Request" then
Conn.Close
server.transfer "Request.asp"
end if
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'dim rs3
'dim sql3
'sql3 = "Select * FROM tBB WHERE tBB.BBID = " & BBID & ""
'set rs3=Conn.execute(sql3)
%>
Villa Cayman is Grand Cayman Island's most exotic vacation rental home.
Villa Cayman Availability Calendar
Scroll to the date you are
interested in, or select the specific date, and press 'Look It Up'.
<%=(BasicErrStr)%>
<%=(FormatDateTime(ddate,1))%> to <%=(FormatDateTime(DateAdd("d",27,ddate),1))%>
<%
tableheading
tablerows
%>
<%
dim i
for i=1 to ubound(roomdate)
%><%
next
dim i2
for i2=1 to ubound(runningarray)
%><%
next
%>
" & vbcrlf
Response.Write "Sorry, no Calendar matching your request was located! " & vbcrlf
Response.Write "Should this problem persist please contact our Support Team"
Response.Write ""
End If
Conn.Close
set conn=nothing
%>