Analog_Reports.ASP

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<HTML>
<HEAD>
<TITLE>Analog_Reports.ASP</TITLE>
</HEAD>

<BODY >

<H1>Analog Reports</H1>
<%
  Dim strAnalogPath
  Dim objFSO
  Dim objRootDir
  Dim colFolders 
  Dim objFolder 
  Dim colDays
  Dim objSubDays
  Dim objRegExp
  CONST ANALOG_VDIR = "/Analog/"

  'Look for Query String
  Dim sYear 
  Dim sMonthPattern
  Dim sYearPattern
  sYear = Request.QueryString("Year")
  if sYear = "" Then
    '200601
    sMonthPattern = "^" & Year(Now()) & "\d\d$"
    sYearPattern  = "^" & Year(Now()) & "$"
  Else
    if IsNumeric(sYear) Then
      if sYear > 2000 and sYear < 2025 Then
        sMonthPattern = "^" & sYear & "\d\d$"
        sYearPattern  = "^" & sYear & "$"
      Else
        Response.Write "Year must be between 2000 and 2025."
        Repsonse.end
      end if
    Else
        Response.Write "Year must be a number."
        Repsonse.end
    end if
  End if
  
  Set objFSO = Server.CreateObject("Scripting.FileSystemObject")  'Open File System Object
  strAnalogPath = Server.MapPath(ANALOG_VDIR)
  Set objRootDir = objFSO.GetFolder(strAnalogPath)

  Set objRegExp = New RegExp
  Set colFolders = objRootDir.SubFolders
  For Each objFolder In colFolders 
    objRegExp.Pattern = sYearPattern 
    If objRegexp.Test(objFolder.Name) Then
      Call WriteYear(objRootDir, objFolder.Name)
    End If
  Next

  Set objRegExp = New RegExp
  Set colFolders = objRootDir.SubFolders
  For Each objFolder In colFolders 
    objRegExp.Pattern = sMonthPattern
    If objRegexp.Test(objFolder.Name) Then
      Call WriteMonth(objRootDir, objFolder.Name)
    End If
  Next

  Set objFSO = Nothing
  Set objRootDir = Nothing
  Set objRegExp = Nothing

Function WriteYear(objRootDir, strYYYY)
  Dim strYear
  strYear = Left(strYYYYMM, 4)
  Response.Write "<TABLE BORDER=1 CELLSPACING=0 CELLPADDING=0 WIDTH=""50%"">" & vbCRLF
  Response.Write "  <TR ALIGN=left VALIGN=middle>" & vbCRLF
  Response.Write "    <TH COLSPAN=8 ALIGN=Center WIDTH=""100%"">" & vbCRLF
  Response.Write "      <A HREF=" & CHR(34) & ANALOG_VDIR & strYYYY & "/Report.HTML" & CHR(34) & ">" & strYYYY & "</a>" & vbCRLF
  Response.Write "      <A HREF=" & CHR(34) & ANALOG_VDIR & strYYYY & "/RM" & CHR(34) & "><small>®</small></a><BR />" & vbCRLF
  Response.Write "    </TH>" & vbCRLF
  Response.Write "  </TR>" & vbCRLF
  Response.Write "</TABLE>" & vbCRLF
  Response.Write "<BR />" & vbCRLF
End Function

Function WriteMonth(objRootDir, strYYYYMM)
  Dim strYear
  Dim strMonth
  Dim dtFirstOfMonth
  Dim dtLastOfMonth
  Dim iFirstOfMonthDOW
  Dim iWeeks
  Dim iDays
  Dim iCount
  Dim iCal
  Dim aCal()
  Dim dtCurrentDay
  Dim strWeek
  CONST TD_START = "    <TD><B>"
  CONST TD_END   = "</B></TD>"
  CONST TD_BLANK = "    <TD>&nbsp;</TD>"


  strYear = Left(strYYYYMM, 4)
  strMonth = Right(strYYYYMM, 2)
  dtFirstOfMonth = DateSerial(strYear, strMonth, 1)
  iFirstOfMonthDOW =  WeekDay (dtFirstOfMonth)
  dtLastOfMonth = DateSerial(strYear, strMonth + 1, 0)
  iCal = 1
  ReDim aCal(44)
  For iCount = iFirstOfMonthDOW to iFirstOfMonthDOW + DateDiff("D", dtFirstOfMonth, dtLastOfMonth)
    aCal(iCount) = iCal
    iCal = iCal + 1
  Next

  Response.Write "<TABLE BORDER=1 CELLSPACING=0 CELLPADDING=0 WIDTH=""50%"">" & vbCRLF
  Response.Write "  <TR ALIGN=left VALIGN=middle>" & vbCRLF
  Response.Write "    <TH COLSPAN=8 ALIGN=Center WIDTH=""100%"">" & vbCRLF
  Response.Write "      <A HREF=" & CHR(34) & ANALOG_VDIR & strYYYYMM & "/Report.HTML" & CHR(34) & ">" & MonthName(Month(dtFirstOfMonth), true) & " " & LEFT(strYYYYMM,4) & "</a>" & vbCRLF
  Response.Write "      <A HREF=" & CHR(34) & ANALOG_VDIR & strYYYYMM & "/RM" & CHR(34) & "><small>®</small></a><BR />" & vbCRLF
  Response.Write "    </TH>" & vbCRLF
  Response.Write "  </TR>" & vbCRLF
  Response.Write "  <TR ALIGN=Center VALIGN=middle>" & vbCRLF
  Response.Write "    <TH WIDTH=""13%"">Sun</TH>" & vbCRLF
  Response.Write "    <TH WIDTH=""12%"">Mon</TH>" & vbCRLF
  Response.Write "    <TH WIDTH=""13%"">Tue</TH>" & vbCRLF
  Response.Write "    <TH WIDTH=""12%"">Wed</TH>" & vbCRLF
  Response.Write "    <TH WIDTH=""13%"">Thr</TH>" & vbCRLF
  Response.Write "    <TH WIDTH=""12%"">Fri</TH>" & vbCRLF
  Response.Write "    <TH WIDTH=""13%"">Sat</TH>" & vbCRLF
  Response.Write "    <TH WIDTH=""12%"">EOW</TH></TR>" & vbCRLF

  For iWeeks = 0 to 5  'Max weeks is 6
    Response.Write "  <TR ALIGN=Center VALIGN=middle>" & vbCRLF
    For iDays = 1 to 7 'Days
      If aCal(iWeeks * 7 + iDays) > 0 Then
        dtCurrentDay = DateSerial (strYear, strMonth, aCal(iWeeks * 7 + iDays) )
        If objFSO.FolderExists(objFSO.BuildPath(objRootDir, strYYYYMM & LZeroPad(aCal(iWeeks * 7 + iDays),2))) Then
          Response.Write TD_START & vbCRLF
          Response.Write "<A HREF=" & CHR(34) & ANALOG_VDIR & strYYYYMM & LZeroPad(aCal(iWeeks * 7 + iDays),2) & "/Report.HTML" & CHR(34) & ">" & LZeroPad(aCal(iWeeks * 7 + iDays),2) & "</a>" & vbCRLF
          Response.Write " <A HREF=" & CHR(34) & ANALOG_VDIR & strYYYYMM & LZeroPad(aCal(iWeeks * 7 + iDays),2) & "/RM" & CHR(34) & "><small>®</small></a>" & vbCRLF
          Response.Write TD_END & vbCRLF
        Else
          Response.Write "    <TD>" & LZeroPad(aCal(iWeeks * 7 + iDays),2) & "</TD>" & vbCRLF
        End if
      Else
        Response.Write TD_BLANK & vbCRLF
      End if
    Next

    'Write out EOW Report
    strWeek = LZeroPad(DatePart("ww", dtCurrentDay),2)
    If objFSO.FolderExists(objFSO.BuildPath(objRootDir, strYear & "_W" & strWeek)) Then
      Response.Write TD_START & vbCRLF
      Response.Write "<A HREF=" & CHR(34) & ANALOG_VDIR & strYear & "_W" & strWeek & "/Report.HTML" & CHR(34) & ">W" & strWeek & "</a>" & vbCRLF
      Response.Write " <A HREF=" & CHR(34) & ANALOG_VDIR & strYear & "_W" & strWeek & "/RM" & CHR(34) & "><small>®</small></a>" & vbCRLF
      Response.Write TD_END & vbCRLF
    Else
      Response.Write "    <TD>W" & strWeek & "</TD>" & vbCRLF
    End if
    Response.Write "  </TR>" & vbCRLF

    'Make sure we don't put out a blank week
    If iWeeks > 0 Then
      If aCal(iWeeks * 7 + iDays) = 0  Then
        Exit For
      End if
    End if
  Next
  Response.Write "</TABLE>" & vbCRLF
  Response.Write "<BR />" & vbCRLF
End Function

Function LZeroPad(iNumber, iDigits)
  Dim iLen
  Dim iCount
  Dim strTemp
  iLen = LEN(iNumber)
  strTemp = iNumber
  If iLen < iDigits Then
    For iCount = 1 to iDigits - iLen
      strTemp  = "0" & strTemp
    Next
  End if
  LZeroPad = strTemp
End function
%>
</BODY>
</HTML>