Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

shared web calander

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • shared web calander

    This is my shared web calander SuperCal.
    It is written in PBCC v4 and requires powerTree.
    You can see it work at www.nbson.com/superCal.htm
    For some reason, this will NOT work with FireFox. If anyone
    has the time, feel free to make it do so.
    This is a stripped-down version of part of a large project I
    did for a customer intranet. I hope I removed all extra code
    or variables that are no longer needed.

    Code:
    '     program: superCal
    ' description: PBCC program for loading shared calander
    '       input: month to load in format mm/dd/yyyy
    '     output : html calander for right month including information per day      
    '      notes : requires powerTree index manager     
    '      owner : Shawn Anderson [email protected] 
    '              Use this program at your own risk!
    '-------------------------------------------------------------------------------
    
    ' includes    
    #INCLUDE "pbcgi.inc"
    #INCLUDE "ptree.inc"
    #INCLUDE "datex.inc"
    #INCLUDE "superCal.inc"
    
    FUNCTION PBMAIN()
      LOCAL sParams AS STRING      
      LOCAL d AS STRING      
      LOCAL result AS LONG
      LOCAL editAccess AS LONG
    
    ' read from stdin
      sParams = readCGI    
    
    ' parse out date                          
      d = cgiParam(sParams,"d")        
      
    ' give ability to edit calander  
      editAccess = -1  ' change to false to disallow access
        
      result = loadCal(d,editAccess)
       
    END FUNCTION
    ******************************************************
    Code:
    '     program: saveCnotes
    ' description: saves superCal calender notes
    '       input: notes, month to save in, color
    '     output : HTML calender for current month
    '-------------------------------------------------------------------------------
    
    #INCLUDE "pbcgi.inc"
    #INCLUDE "ptree.inc"
    #INCLUDE "datex.inc"
    #INCLUDE "superCal.inc"
    
    FUNCTION PBMAIN()
      LOCAL sParams AS STRING      
      LOCAL d AS STRING      
      LOCAL tData AS STRING
      LOCAL hasAccess AS LONG
      LOCAL strID AS STRING * 10
      LOCAL keyBlock AS accessBlock       
      LOCAL result AS LONG    
      LOCAL cNotesVar AS cNotesType
      LOCAL recs AS LONG
      LOCAL fName AS STRING
      LOCAL fNumber AS LONG
      LOCAL searchDay AS STRING * 10     
      LOCAL longDate AS STRING
      LOCAL editAccess AS LONG
      LOCAL oColor AS STRING
      
      ON ERROR GOTO sdError
      
    ' read from stdin
      sParams = readCGI           
                             
    ' parse out parameters    
      d = cgiParam(sParams,"d")
      tData = cgiParam(sParams,"data")       
      oColor = cgiParam(sParams,"oColor")       
      
    ' populate UDT
      cNotesVar.cDay = d
      cNotesVar.cNotes = tData     
      cNotesVar.cColor = oColor
      
    ' give editor access
      editAccess = -1 ' change to 0 to dissallow access
        
    ' if they don't have edit access, then they cant save!
      IF NOT editAccess THEN
        writeCGI "Sorry, you do not have rights to save Calendar data"
        EXIT FUNCTION
      END IF  
    
    '-------------------------------------------------------  
    ' save data to specified day     
    '-------------------------------------------------------  
      
    ' open index
    ' open user index
      result = openIndex(%calDN,keyblock)
      IF result <> -1  THEN
        writeCGI "Error opening calendar notes index : "+STR$(result)
        GOTO sdError
      END IF
    
    ' open user db
      fNumber = FREEFILE
      fName = "data/calDN.dat"
      OPEN fName FOR RANDOM AS #fNumber LEN=SIZEOF(cNotesVar)
      recs = LOF(fNumber)/LEN(cNotesVar)
    
    ' check for existing record
      searchDay = cNotesVar.cDay
      ptff searchDay, KeyBlock
      IF ISFALSE KeyBlock.ErrType THEN
        ' duplicate record - KeyBlock.RecordNumber
        ' already exists in index so just update data file
          PUT #fNumber,keyBlock.recordNumber, cNotesVar
      ELSE
        ' new record
        ' update db    
          PUT #fNumber, recs+1,cNotesVar
    
        ' update user index
          KeyBlock.Recordnumber= (recs+1)
          ptAdd searchDay, KeyBlock
      END IF
    
    ' close userID db and ID index
      CLOSE #fNumber
      ptClose KeyBlock
      
    ' reload calander  
      longDate = TRIM$(serial2Date(VAL(d)))
      REPLACE "-" WITH "/" IN longDate
      MID$(longDate,4,2)="01"
      
      result = loadCal(longDate,editAccess)
    
    EXIT FUNCTION
    
    sdError:
      writeCGI "<p>Error saving calender notes information<p>"
      EXIT FUNCTION
      
    END FUNCTION
    ******************************************************

    Code:
    '     program: saveDay
    ' description: saves superCal calender data
    '       input: julian number of day to save, info, color of info
    '     output : HTML calender for current month
    '-------------------------------------------------------------------------------
    
    #INCLUDE "pbcgi.inc"
    #INCLUDE "ptree.inc"
    #INCLUDE "datex.inc"    
    #INCLUDE "superCal.inc"
    
    FUNCTION PBMAIN()
      LOCAL sParams AS STRING      
      LOCAL d AS STRING      
      LOCAL tData AS STRING  
      LOCAL keyBlock AS accessBlock       
      LOCAL result AS LONG    
      LOCAL calVar AS calType
      LOCAL recs AS LONG
      LOCAL fName AS STRING
      LOCAL fNumber AS LONG
      LOCAL searchDay AS STRING * 10     
      LOCAL longDate AS STRING
      LOCAL editAccess AS LONG
      LOCAL oColor AS STRING
      
      ON ERROR GOTO sdError
      
    ' read from stdin
      sParams = readCGI           
                       
    ' parse out parameters    
      d = cgiParam(sParams,"d")             'day in julian number form
      tData = cgiParam(sParams,"data")      'info stored in day
      oColor = cgiParam(sParams,"oColor")   'HTML color of info    
      
    ' populate UDT
      calVar.cDay = d
      calVar.cDescription = tData     
      calVar.cColor = oColor
      
    ' set editor access
      editAccess = -1
      
    
    '-------------------------------------------------------  
    ' save data to specified day     
    '-------------------------------------------------------  
     
    ' open index
    ' open user index
      result = openIndex(%calDD,keyblock)
      IF result <> -1  THEN
        writeCGI "Error opening calendar index : "+STR$(result)
        GOTO sdError
      END IF
    
    ' open user db
      fNumber = FREEFILE
      fName = "data/calDD.dat"
      OPEN fName FOR RANDOM AS #fNumber LEN=SIZEOF(calVar)
      recs = LOF(fNumber)/LEN(calVar)
    
    ' check for existing record
      searchDay = calVar.cDay
      ptff searchDay, KeyBlock
      IF ISFALSE KeyBlock.ErrType THEN
        ' duplicate record - KeyBlock.RecordNumber
        ' already exists in index so just update data file
          PUT #fNumber,keyBlock.recordNumber, calVar
      ELSE
        ' new record
        ' update db
          PUT #fNumber, recs+1,calVar
    
        ' update user index
          KeyBlock.Recordnumber= (recs+1)
          ptAdd searchDay, KeyBlock
      END IF
    
    ' close userID db and ID index
      CLOSE #fNumber
      ptClose KeyBlock
      
    ' reload calander  
      longDate = TRIM$(serial2Date(VAL(d)))
      REPLACE "-" WITH "/" IN longDate
      MID$(longDate,4,2)="01"
      
      result = loadCal(longDate,editAccess)
    
    EXIT FUNCTION
    
    sdError:
      writeCGI "<p>Error saving calender information<p>"
      EXIT FUNCTION
    
    END FUNCTION
    ******************************************************

    Code:
    ' include file for superCal
    
    ' UDTs
    TYPE calType
      cDay AS STRING * 10
      cDescription AS STRING * 140
      cColor AS STRING * 6
    END TYPE
    
    TYPE cNotesType
      cDay AS STRING * 10
      cNotes AS STRING * 512
      cColor AS STRING * 6
    END TYPE        
    
    ' constants
    %calDD = 1
    %calDN = 2    
    
    ' function delclarations
    DECLARE FUNCTION loadCal(d AS STRING,editAccess AS LONG) AS LONG       
    DECLARE FUNCTION OpenIndex(i%, KeyBlock AS Accessblock) AS LONG    
    DECLARE FUNCTION Exists(BYVAL eFile AS STRING) AS LONG             
    DECLARE FUNCTION listParams(sParams AS STRING) AS LONG
    
    FUNCTION loadCal(d AS STRING,editAccess AS LONG) AS LONG
      LOCAL i AS LONG
      LOCAL j AS LONG
      LOCAL monthName AS STRING
      LOCAL monthYear AS STRING
      LOCAL monthNum AS LONG
      LOCAL calVar AS calType
      LOCAL dayNumber AS LONG
      LOCAL monthDays AS LONG
      LOCAL wMonth AS LONG
      LOCAL wYear AS LONG
      LOCAL dayCounter AS LONG
      LOCAL countDown AS LONG
      LOCAL countDownDiff AS LONG
      LOCAL finalCountDown AS LONG
      LOCAL sMonth AS STRING
      LOCAL sYear AS STRING
      LOCAL userID AS STRING
      LOCAL pw AS STRING
      LOCAL tpw AS STRING
      LOCAL keyBlock AS accessBlock
      LOCAL notesBlock AS accessBlock
      LOCAL result AS LONG
      LOCAL fName AS STRING
      LOCAL fNumber AS LONG
      LOCAL recs AS LONG
      LOCAL DC AS STRING
      LOCAL fullDate AS STRING
      LOCAL taData AS STRING
      LOCAL searchSer AS STRING * 10
      LOCAL searchDay AS STRING * 10
      LOCAL ea AS STRING
      LOCAL oColor AS STRING
      LOCAL cNotesVar AS cNotesType
      LOCAL taNotes AS STRING
      LOCAL taColor AS STRING
    
      ON ERROR GOTO lcError
    
    ' build calander        
      monthNum = VAL(LEFT$(d,2))
      monthName= month2Name(monthNum)
      monthYear = RIGHT$(d,4)   
      MID$(d,4,2)="01"                 
    
    ' write top HTML and start table
      writeCGI "<html><head><title>Calendar for "+d+"</title><style>"
      writeCGI " body {background:#ffffff;font-family:arial;font-size:10pt}"
      writeCGI " td {background:#ffffff;font-family:arial;font-size:8pt}"
      writeCGI " table {width:600;border:1px solid black}"
      writeCGI " .tb {border:1px solid #28a3c2}"
      writeCGI " .tb2 {border:1px solid #28a3c2;background:#eeeeee;text-align:center}"
      writeCGI " textarea {font-size:10;color:#000000;font-family:arial;background:#f6e3a0;behavior:url(../css/maxlength.htc)};"
      writeCGI "</style>"
      writeCGI "<script type='text/javascript'>"        
    
      writeCGI "  function saveIt(d){"
      writeCGI "    var ttmp1='t'+d;"
      writeCGI "    var ttmp2=document.getElementById(ttmp1);"
      writeCGI "    var ddata=ttmp2.value"
      writeCGI "    var objColor = right(ttmp2.currentStyle["+CHR$(34)+"color"+CHR$(34)+"],6);"
      writeCGI "    var sendString = 'saveDay.cgi?data='+escape(ddata)+'&oColor='+objColor+'&d='+d;"
      writeCGI "    window.open(sendString,'_top');"
      writeCGI "  }"
    
      writeCGI "  function saveNotes(){"
      writeCGI "    var ttmp1="+CHR$(39)+TRIM$(STR$(date2serial(d)))+CHR$(39)+";"
      writeCGI "    var ttmp2=document.getElementById('n'+ttmp1);"
      writeCGI "    var ddata=ttmp2.value"
      writeCGI "    var objColor = right(ttmp2.currentStyle["+CHR$(34)+"color"+CHR$(34)+"],6);"
      writeCGI "    var sendString = 'saveCnotes.cgi?d="+TRIM$(STR$(date2serial(d)))+"&data='+escape(ddata)+'&oColor='+objColor;"
      writeCGI "    window.open(sendString,'_top');"
      writeCGI "  }"
    
      writeCGI " function setColor(dValue,cValue){"
      writeCGI "    var tDay = dValue;"
      writeCGI "    var obj = document.getElementById(tDay);"
      writeCGI "    obj.style.color = cValue;"
      writeCGI "  }"
    
      writeCGI "function right(str, n){"
      writeCGI "    if (n <= 0)"
      writeCGI "       return "+CHR$(34)+CHR$(34)+";"
      writeCGI "    else if (n > String(str).length)"
      writeCGI "       return str;"
      writeCGI "    else {"
      writeCGI "       var iLen = String(str).length;"
      writeCGI "       return String(str).substring(iLen, iLen - n);"
      writeCGI "    }"
      writeCGI "}"
    
      writeCGI "</script>"
      writeCGI "</head><body>"
      writeCGI "<table>"
      writeCGI "<tr style='background:#bae7f4'><th colspan=7>"
      writeCGI monthName+" "+monthYear+" "+"Notes"
      writeCGI "</th></tr>"
    
      writeCGI "<tr>"
      writeCGI "<td colspan=7>"
    
      IF editAccess THEN
        ea = "<span style='cursor:hand;text-decoration:underline;color:blue' onClick='saveNotes()'>save</span>  "
        ea = ea+"<span style='cursor:hand;' onClick='setColor("+CHR$(34)+"n"+TRIM$(STR$(date2serial(d)))+CHR$(34)+","+CHR$(34)+"#ff0000"+CHR$(34)+")'><img border=0 src='../data/rdot.jpg'></span>  "
        ea = ea+"<span style='cursor:hand;'  onClick='setColor("+CHR$(34)+"n"+TRIM$(STR$(date2serial(d)))+CHR$(34)+","+CHR$(34)+"#000000"+CHR$(34)+")'><img border=0 src='../data/bdot.jpg'></span>"
      ELSE
        ea = " "
      END IF
    
      GOSUB getNotes
    
      writeCGI ea+"<br>"
      writeCGI "<textarea cols=97 rows=7 name="+CHR$(39)+"n"+TRIM$(STR$(date2serial(d)))+CHR$(39)
      writeCGI "id="+CHR$(39)+"n"+TRIM$(STR$(date2serial(d)))+CHR$(39)+" maxlength=512 wrap='PHYSICAL' "
      writeCGI "style='font-size:10pt;overflow:hidden;color:"+taColor+CHR$(39)+">"+taNotes+"</textarea>"
      writeCGI "</td></tr>"
    
      writeCGI "<tr style='background:#bae7f4'><th colspan=7>"
      writeCGI monthName+" "+monthYear
      writeCGI "</th></tr>"
      writeCGI "<tr>"
      writeCGI "<td class=tb2>Sunday</td>"
      writeCGI "<td class=tb2>Monday</td>"
      writeCGI "<td class=tb2>Tuesday</td>"
      writeCGI "<td class=tb2>Wednesday</td>"
      writeCGI "<td class=tb2>Thursday</td>"
      writeCGI "<td class=tb2>Friday</td>"
      writeCGI "<td class=tb2>Saturday</td>"
      writeCGI "</tr>"
    
    
    ' get the start day
      SELECT CASE dayOfTheWeek(d)
        CASE "Mon"
          dayNumber = 2
        CASE "Tue"
          dayNumber = 3
        CASE "Wed"
          dayNumber = 4
        CASE "Thu"
          dayNumber = 5
        CASE "Fri"
          dayNumber = 6
        CASE "Sat"
          dayNumber = 7
        CASE "Sun"
          dayNumber = 1
        CASE ELSE
          writeCGI "<p>Error in superCal</p>"
          EXIT FUNCTION
      END SELECT
    
    ' get days in month
      wMonth = VAL(LEFT$(d,2))
      wYear = VAL(RIGHT$(d,4))
      sMonth = LEFT$(d,2)
      sYear = RIGHT$(d,4)
      monthDays = daysInMonth(BYVAL wMonth, BYVAL wYear)
    
    ' -----------------------------------------------------------
    ' open index and data file
    ' -----------------------------------------------------------
    ' open user index
      result = openIndex(%calDD,keyblock)
      IF result <> -1  THEN
        writeCGI "Error opening calendar index : "+STR$(result)
        GOTO lcError
      END IF
    
    ' open user db
      fNumber = FREEFILE
      fName = "data/calDD.dat"
      OPEN fName FOR RANDOM AS #fNumber LEN=SIZEOF(calVar)
      recs = LOF(fNumber)/LEN(calVar)
    
    ' fill in the first line of table
      dayCounter = 1
      writeCGI "<tr>"
      FOR i = 1 TO 7
        IF dayNumber > i THEN
          writeCGI "<td> </td>"
        ELSE
          GOSUB addDay
          INCR dayCounter
        END IF
      NEXT
      writeCGI "</tr>"
    
    ' fill in middle 3 rows of table
      FOR i = 1 TO 3
        writeCGI "<tr>"
        FOR j = 1 TO 7
          GOSUB addDay
          INCR dayCounter
        NEXT
        writeCGI "</tr>"
      NEXT
    
    ' fill in bottom row of table
      writeCGI "<tr>"
      countDown = monthDays-dayCounter+1
      IF countDown > 7 THEN
        countDownDiff = countDown-7
        countDown=7
      ELSE
        countDownDiff = 0
      END IF
      FOR i = 1 TO countDown
          GOSUB addDay
          INCR dayCounter
      NEXT
      writeCGI "</tr>"
    
    ' make sure there isn't another row, if so print it
      IF countDownDiff > 0 THEN
      finalCountDown = 7-countDownDiff
      writeCGI "<tr>"
        FOR i = 1 TO countDownDiff
          GOSUB addDay
          INCR dayCounter
        NEXT
        FOR i = 1 TO finalCountDown
          writeCGI "<td> </td>"
        NEXT
      writeCGI "</tr>"
      END IF
    
    ' close index and data file
      CLOSE #fNumber
      ptClose KeyBlock
    
    ' end table and html document
      writeCGI "</table>"
      writeCGI "</body></html>"
    
    EXIT FUNCTION
      lcError:
        writeCGI "<p>Error in loadCal()"+STR$(ERR)+"<p>"
        EXIT FUNCTION
    
    
      addDay:
          DC = TRIM$(STR$(dayCounter))
          IF LEN(DC)=1 THEN DC = "0"+DC
    
          fullDate = sMonth+"/"+DC+"/"+sYear
          calVar.cDay = TRIM$(STR$(date2serial(fullDate)))
    
        ' search for day data
          searchDay = calVar.cDay
          ptff searchDay, KeyBlock
          IF ISFALSE KeyBlock.ErrType THEN
          ' duplicate record - KeyBlock.RecordNumber
          ' already exists in index so just update data file
            GET #fNumber,keyBlock.recordNumber, calVar
            taData = TRIM$(calVar.cDescription)
            oColor = "#"+TRIM$(calVar.cColor)
          ELSE
            taData = ""
            oColor = "#000000"
    
          END IF
    
          IF editAccess THEN
            ea = "<span style='cursor:hand;text-decoration:underline;color:blue' onClick='saveIt("+TRIM$(calVar.cDay)+")'>save</span>  "
            ea = ea+"<span style='cursor:hand;' onClick='setColor("+CHR$(34)+"t"+TRIM$(calVar.cDay)+CHR$(34)+","+CHR$(34)+"#ff0000"+CHR$(34)+")'><img border=0 src='../data/rdot.jpg'></span>  "
            ea = ea+"<span style='cursor:hand;'  onClick='setColor("+CHR$(34)+"t"+TRIM$(calVar.cDay)+CHR$(34)+","+CHR$(34)+"#000000"+CHR$(34)+")'><img border=0 src='../data/bdot.jpg'></span>"
          ELSE
            ea = " "
          END IF
    
          writeCGI "<td class=tb><b>"+STR$(dayCounter)+" </b>"+ea+"<br><textarea style='overflow:hidden;color:"+oColor+_
          " ' wrap='PHYSICAL' maxlength=140 cols=18 rows=10 id='t"+TRIM$(calVar.cDay)+CHR$(39)+" name='t"+TRIM$(calVar.cDay)+CHR$(39)+_
          ">"+taData+"</textarea></td>"
      RETURN
    
      getNotes:
      ' open user index
        result = openIndex(%calDN,notesBlock)
        IF result <> -1  THEN
          writeCGI "Error opening calendar Notes index : "+STR$(result)
          GOTO lcError
        END IF
    
      ' open user db
        fNumber = FREEFILE
        fName = "data/calDN.dat"
        OPEN fName FOR RANDOM AS #fNumber LEN=SIZEOF(cNotesVar)
    
        searchSer = TRIM$(STR$( date2serial(d) ))
    
          searchDay = searchSer
          ptff searchDay, notesBlock
          IF ISFALSE notesBlock.ErrType THEN
          ' duplicate record - notesBlock.RecordNumber
          ' already exists in index so just update data file
            GET #fNumber,notesBlock.recordNumber, cNotesVar
            taNotes = TRIM$(cNotesVar.cNotes)
            taColor = "#"+TRIM$(cNotesVar.cColor)
          ELSE
            taNotes = ""
            taColor = "#000000"
          END IF
    
      ' close index and data file
        CLOSE #fNumber
        ptClose notesBlock
    
      RETURN                
    
    END FUNCTION
    
    '---------------------------------------------------------------------------
    ' function name: openIndex
    '   description: opens pTree index files
    '         input: file handle of index, UDT for pTree functions
    '       returns: true (success) or false (can't open index)
    FUNCTION OpenIndex(i%, KeyBlock AS Accessblock) AS LONG
      LOCAL fname AS ASCIIZ * 255
      KeyBlock.Multiuser=1         
    
      SELECT CASE i%
        CASE %calDD 'day
          keyBlock.keyLength = 10
          fName = "data/calDD.ndx" 'change this path to wherever you keep your data
        CASE %calDN 'first day
          keyBlock.keyLength = 10
          fName=  "data/calDN.ndx" 'change this path to wherever you keep your data 
      END SELECT
    
      IF NOT exists(TRIM$(fname)) THEN
        ptCreateIndex TRIM$(fname), KeyBlock
        IF ISTRUE KeyBlock.ErrType THEN
          FUNCTION = KeyBlock.ErrType
          EXIT FUNCTION
        END IF
      END IF
    
      ptInit TRIM$(fname),Keyblock
      IF ISTRUE KeyBlock.ErrType THEN
        FUNCTION = KeyBlock.ErrType
      END IF
    
      FUNCTION = -1
    
    END FUNCTION
    
    '---------------------------------------------------------------------------
    ' function name: Exists
    '   description: checks to see if a file exists
    '         input: eFile : (variable holding name of file)
    '       returns: true or false
    FUNCTION Exists(BYVAL eFile AS STRING) AS LONG
      FUNCTION = (LEN(DIR$(eFile)) > 0)
    END FUNCTION
    
    '---------------------------------------------------------------------------
    '      sub name: listParams
    '   description: utility to list all passed parameters from stdin
    '         input: stdin from CGI
    '       returns: writes HTML with variable/value pairs    
    '         notes: used mostly for testing: what params are being passed 
    '                to the CGI?
    FUNCTION listParams(sParams AS STRING) AS LONG
       REDIM param$(1)
       ncParamCount& = ParseParams(sParams, Param$())
       IF ncParamCount& THEN
            writeCGI "<ol>"
            FOR ix& = 1 TO ncParamCount&
                WriteCGI "<li>" & DecodeCGI(Param$(ix&))
            NEXT ix&
            writeCGI "</ol>"
       END IF
    END FUNCTION
    ******************************************************

    Code:
    ' datex.inc
    
    FUNCTION Date2Year% (datex$) STATIC
       Date2Year% = VAL(MID$(datex$, 7))
    END FUNCTION
    
    FUNCTION Date2Mth% (datex$) STATIC
       Date2Mth% = VAL(datex$)
    END FUNCTION
    
    FUNCTION Date2Day% (datex$) STATIC
       Date2Day% = VAL(MID$(datex$, 4))
    END FUNCTION
    
    FUNCTION Date2Serial& (datex$) STATIC
       Month% = Date2Mth%(datex$)
       Day% = Date2Day%(datex$)
       Year% = Date2Year%(datex$)
       IF Month% > 2 THEN
          Month% = Month% - 3
       ELSE
          Month% = Month% + 9
          Year% = Year% - 1
       END IF
       TA& = 146097 * (Year% \ 100) \ 4
       TB& = 1461& * (Year% MOD 100) \ 4
       TC& = (153 * Month% + 2) \ 5 + Day% + 1721119
       Date2Serial& = TA& + TB& + TC&
    END FUNCTION
    
    FUNCTION MDY2Date$ (Month%, Day%, Year%) STATIC
       MDY2Date$ = RIGHT$("0" + MID$(STR$(Month%), 2), 2) + "-" + RIGHT$("0" + MID$(STR$(Day%), 2), 2) + "-" + RIGHT$("000" + MID$(STR$(Year%), 2), 4)
    END FUNCTION
    
    FUNCTION Serial2Date$ (serial&) STATIC
       X& = 4 * serial& - 6884477
       Y& = (X& \ 146097) * 100
       D& = (X& MOD 146097) \ 4
    
       X& = 4 * D& + 3
       Y& = (X& \ 1461) + Y&
       D& = (X& MOD 1461) \ 4 + 1
    
       X& = 5 * D& - 3
       M& = X& \ 153 + 1
       D& = (X& MOD 153) \ 5 + 1
    
       IF M& < 11 THEN
          Month% = M& + 2
       ELSE
          Month% = M& - 10
       END IF
    
       Day% = D&
       Year% = Y& + M& \ 11
    
       datex$ = MDY2Date$(Month%, Day%, Year%)
       Serial2Date$ = datex$
    END FUNCTION
    
    FUNCTION DayOfTheWeek$ (DateX$) STATIC
       DayOfTheWeek$ = MID$("MonTueWedThuFriSatSun",((Date2Serial&(DateX$) MOD 7) + 1) * 3 - 2, 3)
    END FUNCTION   
    
    FUNCTION isLeapYear(Year AS LONG ) AS LONG      
      FUNCTION = 0      
      IF ( (Year MOD 4) = 0) AND ( (Year MOD 100) > 0) OR ( (Year MOD 400) = 0) THEN FUNCTION = -1    
    END FUNCTION
    
    ' returns number of days in given month, year
    FUNCTION DaysInMonth(BYVAL wMonth AS LONG, BYVAL wYear AS LONG) AS LONG
      SELECT CASE wMonth
        CASE 1, 3, 5, 7, 8, 10, 12       ' Jan, Mar, May, Jul, Aug, Oct, Dec
          FUNCTION = 31
        CASE 4, 6, 9, 11                 ' Apr, Jun, Sep, Nov
          FUNCTION = 30
        CASE 2                           ' Feb
          ' is it a Leap Year?
            IF isLeapYear(wYear) THEN 
              FUNCTION = 29
            ELSE
              FUNCTION = 28
            END IF  
      END SELECT
    END FUNCTION
    
    
    FUNCTION month2Name(BYVAL wMonth AS LONG) AS STRING
      SELECT CASE wMonth
          CASE 1
            FUNCTION = "January"
          CASE 2
            FUNCTION = "February"
          CASE 3
            FUNCTION = "March"
          CASE 4
            FUNCTION = "April"
          CASE 5              
            FUNCTION = "May"
          CASE 6            
            FUNCTION = "June"
          CASE 7             
            FUNCTION = "July"
          CASE 8             
            FUNCTION = "August"
          CASE 9               
            FUNCTION = "September"
          CASE 10
            FUNCTION = "October"
          CASE 11
            FUNCTION = "November"
          CASE 12
            FUNCTION = "December"
          CASE ELSE
            FUNCTION = "Error"  
      END SELECT
    
    END FUNCTION
    
    FUNCTION name2Month(BYVAL wMonth AS STRING) AS STRING
      LOCAL year AS STRING
      LOCAL longMonth AS STRING
      LOCAL shortMonth AS STRING
      LOCAL lenMonth AS LONG   
        
      wMonth = TRIM$(wMonth)
      
      lenMonth = LEN(wMonth)
      year = RIGHT$(wMonth,4)
      
      longMonth = trim$(LCASE$(LEFT$(wMonth,lenMonth-4)))
      
      SELECT CASE longMonth
        CASE "january"    
          shortMonth = "01"
        CASE "february"    
          shortMonth = "02"
        CASE "march"
          shortMonth = "03"
        CASE "april"
          shortMonth = "04"
        CASE "may"
          shortMonth = "05"
        CASE "june"
          shortMonth = "06"
        CASE "july"
          shortMonth = "07"
        CASE "august"
          shortMonth = "08"
        CASE "september"
          shortMonth = "09"
        CASE "october"
          shortMonth = "10"
        CASE "november"
          shortMonth = "11"
        CASE "december"
          shortMonth = "12"
        CASE ELSE
          shortMonth = "ERROR"  
      END SELECT
            
      FUNCTION = shortMonth+"/01/"+year
    
    END FUNCTION
    ******************************************************

    Code:
    <html>
    <head>
    	<title>SuperCal</title>
      <style>
      	body{background:#ffffff;font-size:10pt;font-family:arial}
      </style>
    </head>
    <body>
      <h3>SuperCal</h3>
      
      Enter a date in the form mm/dd/yyyy:<br>
      
      <form method="post" action="cgi/superCal.cgi">
        <input type="text" name="d" value="08/10/2005">
        <input type="submit" value="Submit">
      </form>
      
    </body>
    </html>

    ------------------
    If you go flying back through time and you see somebody else flying forward into the future, it's probably best to avoid eye contact.



    [This message has been edited by Shawn Anderson (edited August 12, 2005).]

  • #2
    For some reason, this will NOT work with FireFox. If anyone
    has the time, feel free to make it do so.
    Although I see a...
    Code:
    ' end table and html document
      writeCGI "</table>"
      writeCGI "</body></html>"
    ...in your code, if you look at the source of the generated HTML page, you'll find the last tag to be <html>, not </html>.

    Also, there's no cursor:hand in CSS. Should be cursorointer

    A good tool for "debugging" HTML ist the W3C validator:

    http://validator.w3.org/check?verbos...i/superCal.cgi

    Knuth

    ------------------
    http://www.softAware.de

    [This message has been edited by Knuth Konrad (edited August 13, 2005).]

    Comment


    • #3
      the URL validator needs a parameter passed to it like this:
      http://validator.w3.org/check?verbos...i?d=08/10/2005

      good link, thanks


      ------------------
      If you go flying back through time and you see somebody else flying forward into the future, it's probably best to avoid eye contact.

      Comment

      Working...
      X