$TYPECHECK ON
'' Functions List 
'' ----------------- 

'' Function DaysValue(TheDate as string) as Long 
'' Returns the nuber of days from 12-31-1900 (Date Format m-d-yyyy) 

'' Function DayOfWeek(TheDate as string) as integer 
'' Returns Day of Week, 1 Monday, 2 Tue. etc. 

'' Function DaysBetween(FutDate as string, PrevDate as string) as Long 
'' Returns the number of Days from a starting date - to an ending date 
'' without counting the initial starting Date (Date Format m-d-yyyy) 

'' Function WorkDaysBetween(FutDate as string, PrevDate as string) as Long 
'' Returns the number of Working Days from a starting date - to an ending date 
'' without counting the initial starting Date (Date Format m-d-yyyy) 

'' Function DaysOfMonth(TheMonth as Integer,TheYear as Integer) as Integer 
'' The Number of days of a month  


Function DaysValue(TheDate as string) as Long 
   '' TheDate format m-d-yyyy 
   Dim year as integer 
   Dim month as integer 
   Dim day as integer 
   year=val(RIGHT$(TheDate,4)) 
   IF MID$(TheDate,2,1)="-" THEN 
      month=val(LEFT$(TheDate,1)) 
      IF MID$(TheDate,4,1)="-" THEN day=val(MID$(TheDate,3,1)) ELSE day=val(MID$(TheDate,3,2)) 
   ELSE 
      month=val(LEFT$(TheDate,2)) 
      IF MID$(TheDate,5,1)="-" THEN day=val(MID$(TheDate,4,1)) ELSE day=val(MID$(TheDate,4,2)) 
   END IF 
   if year<1901 then goto erlabel: 
   if month>12 then goto erlabel: 
   if (month=1 or month=3 or month=5 or month=7 or month=8 or month=10 or month=12) and day>31 then goto erlabel: 
   if (month=4 or month=6 or month=9 or month=11) and day>30 then goto erlabel: 
   if (month=2 and (year-1901) mod 4=3) and day>29 then goto erlabel: 
   if (month=2 and (year-1901) mod 4<>3) and day>28 then goto erlabel: 
   Dim c as Long 
   c=0 
   dim mc(11) as integer 
   c=c+(year-1901)*365 
   c=c+int((year-1901)/4) 
   mc(0)=0 
   mc(1)=31 
   if (year-1901) mod 4=3 then mc(2)=29 else mc(2)=28 
   mc(3)=31 
   mc(4)=30 
   mc(5)=31 
   mc(6)=30 
   mc(7)=31 
   mc(8)=31 
   mc(9)=30 
   mc(10)=31 
   mc(11)=30 
   Dim i as integer 
   for i=0 to (month-1) 
      c=c+mc(i) 
   next i 
   c=c+day 
   DaysValue=c 
   goto endlabel:  
   erlabel: 
   DaysValue=0 
   endlabel: 
End Function 

Function DayOfWeek(TheDate as string) as integer 
   Dim c as integer 
   c= DaysValue(TheDate) mod 7 
   DayOfWeek = c+1 
   '' 1 is Monday 
End Function 

Function DaysBetween(FutDate as string, PrevDate as string) as Long 
   '' not including prevdate 
   Dim c as Long 
   c=DaysValue(FutDate)-DaysValue(PrevDate) 
   if c>0 then DaysBetween=c else DaysBetween=0 
End Function 

Function WorkDaysBetween(FutDate as string, PrevDate as string) as Long 
   Dim c as Long 
   Dim i as Long 
   Dim j as Long 
   Dim w as integer    
   Dim s as Long 
   Dim k as Long 
   c=DaysValue(FutDate)-DaysValue(PrevDate) 
   i=int(c/7) 
   j=c mod 7 
   w=1+DayOfWeek(PrevDate) 
   if w=8 then w=1 
   s=0 
   for k=1 to j 
      if w=1 or w=2 or w=3 or w=4 or w=5 then s=s+1 
      w=w+1 
      if w=8 then w=1 
   next k 
   if c>0 then WorkDaysBetween=i*5+s else WorkDaysBetween=0 
End Function 

Function DaysOfMonth(TheMonth as Integer,TheYear as Integer) as Integer 
   dim mc(12) as integer 
   mc(0)=0 
   mc(1)=31 
   if (TheYear-1901) mod 4=3 then mc(2)=29 else mc(2)=28 
   mc(3)=31 
   mc(4)=30 
   mc(5)=31 
   mc(6)=30 
   mc(7)=31 
   mc(8)=31 
   mc(9)=30 
   mc(10)=31 
   mc(11)=30 
   mc(12)=31 
   DaysOfMonth=mc(TheMonth) 
End Function 

'' tests 
'
'Print "DaysValue(2-25-2005) = ";DaysValue("2-25-2005") 
'Print "DaysValue(1-1-1901) = ";DaysValue("1-1-1901") 
'Print "DayOfWeek(2-25-2005) = ";DayOfWeek("2-25-2005") 
'Print "DaysBetween(3-1-2005,2-25-2005) = ";DaysBetween("3-1-2005","2-25-2005") 
'Print "WorkDaysBetween(3-1-2005,2-25-2005) = ";WorkDaysBetween("3-1-2005","2-25-2005") 
'Print "DaysOfMonth(2,2005) = ";DaysOfMonth(2,2005) 
'
'Showmessage "read Command window, then click ok"