<%@ 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 & "" & getweekdayabv(iCurrent) & "" & "
" & day(iCurrent) & "

") 'Response.Write(vbTab & vbTab & "" & getweekdayabv(iCurrent) & "" & "
" & day(iCurrent) & "
") Response.Write("" & 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 & " " & rs2("Name") & "") ' else 'Response.Write(vbTab & vbTab & "" & rs2("Name") & "") '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, Grand Cayman Island vacation villa
Villa Cayman home Floor Plan with pictures of rooms Villa Cayman photo gallery Villa Cayman rates Villa Cayman availability calendar Villa Cayman contact information
         
Villa Cayman Availability Calendar
 
Scroll to the date you are interested in, or select the specific date, and press 'Look It Up'.
 
<% tableheading tablerows %> <% dim i for i=1 to ubound(roomdate) %><% next dim i2 for i2=1 to ubound(runningarray) %><% next %>
<%=(BasicErrStr)%>
<%=(FormatDateTime(ddate,1))%> to <%=(FormatDateTime(DateAdd("d",27,ddate),1))%>
   Prev 4 Weeks
Next 4 Weeks   
Select Specific Date >    <%call showdateform ("date")%>  
Last update: <%=rs3("lastupdate")%>             = Vacancy     = No Vacancy
 
 
 
 
 

Intro Page    •    Home/Information    •   Floor Plan    •   Photo Gallery    •   Rates    •   Availability    •   Contact
Copyright © 2002 Villa Cayman. All Rights Reserved.
<% Else Response.Write "Room Keeper Systems" Response.Write "

 
" Response.Write "Room Keeper Systems.

" & 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 %>