'----------------------------------------+---------------------------------------- ' Analog_Run.vbs (Version 1.9) ' Runs analog and ReportMagic for appropriate log files ' Copyright© 2002-2004, Christopher G. Lewis - HTTP://www.ChristopherLewis.com ' ' Many thanks to Stephen Turner for Analog, and Michael Lugassy for helping me ' with the relative path and International Date issues. ' ' parms ' -> Daily Report for Today ' /Day= -> Daily Report for Yesterday ' /Day=MM/DD/YYYY -> Daily Report for date ' /From=MM/DD/YYYY /To=MM/DD/YYYY -> Date Range Report ' /Week= -> Weekly Report for Yesterday ' /Week=MM/DD/YY -> Weekly Report for date ' /Month= -> Monthly Report for Yesterday ' /Month=MM/DD/YY -> Monthly Report for Yesterday ' ' You want to install Analog to a directory (in my case E:\Analog) and install ' ReportMagic the same directory. '' ' If you are using RM, you'll need to copy the RM EXE's and StyleSheet.css to ' the Analog directory ' 'The directory structure ends up like this: ' 'E:\Analog (Analog.exe, RMagic.EXE, Analog.cfg, StypeSheet.css) ' | ' +-Lang ' | ' +-Images ' | ' +-Config ' | ' \-Output ' | ' +-YYYYMMDD ' | | ' | \-RM ' | ' +-YYYYMMDD ' | | ' | \-RM ' | ' +-YYYY_W## ' | | ' | \-RM ' | ' \-YYYYMM ' | ' \-RM ' ' Analog.CFG file changes needed (only if ADJUST_DATE_BY_GMT is FALSE): ' ------------------------------------------------------- 'LOGTIMEOFFSET -360 'LOGFILE E:\LogFiles\W3SVC1\Purged_ex*.log ' - or - 'LOGFILE E:\LogFiles\W3SVC1\ex*.log 'IMAGEDIR ../../Images/ ' ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created ' 020507 CGL Added directory structure comment (v1.1) ' 020507 CGL Added more directory constants to make config easier (v1.2) ' 020509 CGL Fixed Output directory to deal with relative vs. absolute (v1.3) ' 020510 CGL Fixed international date issue (v1.4) ' 020514 CGL Added USE_NEW_FLOORS (v1.5) ' 020822 CGL Added Year Report (v1.6) ' 021029 CGL Fixed RM's Image directory (v1.7) ' 021029 CGL Fixed Program path issue if path had a space in it, (v1.7) ' Thanks to Roduit Didier of Vaudoise Assurances for this one ' 031215 CGL Added a bunch of fixes/enhancements suggested by Ethan Brown, ' including: RM constants, GST Time checks, and a big code cleanup ' for command building stuff. ' 040524 CGL Small fix for RDNS w/ /From= /To= range '----------------------------------------+---------------------------------------- Option Explicit '----------------------------------------+---------------------------------------- ' Configuration - Change these to suit your installation '----------------------------------------+---------------------------------------- CONST ANALOG_ROOT_DIR = "E:\Analog" 'Analog.EXE directory CONST CONFIG_DIR = "configs" 'relative to above. Should be "" if config is in 'same directory as Analog.exe CONST CONFIG_FILE = "Analog.cfg" 'Config file name CONST OUTPUT_DIR = "E:\Analog\Reports" 'OUTPUT_DIR - Can be relative or absolute ' "Output" -> X:\Analog\output\\Report.html ' "C:\Output" -> C:\Output\\Report.html CONST RM_ROOT_DIR = "E:\Analog" 'RM exe directory, could be "c:\program files\reportmagic" CONST RM_SUBDIR = "RM" 'Directory under Output\ for RM report CONST RM_INSTALLED = True 'T/F Is RM Installed CONST RM_IMAGE_DIR = "../../images/" CONST RDNS_ENABLED = True CONST RDNS_EXE = "E:\Analog\rdnslogs.exe" 'absolute path for dns parser CONST RDNS_LOG_SWITCH = " -l " CONST RDNS_CACHE_SWITCH = " -o " CONST RDNS_CACHE_FILE = "dnscache" CONST ADJUST_DATE_BY_GMT = True 'This currently does not change what's in Analog.CFG, and is really only used in Purge_URLScan CONST LOGFILE_ROOT_DIR = "E:\LogFiles\W3SVC1" CONST PURGE_URLSCAN = true 'T/F Purge URLScan lines from IIS logs before processing 'If you use Purge_URLSCAN, your Analog.cfg file's LOGFILE needs to reference Purged_ex*.log ' not ex*.log 'Thease are new floor values for daily/weekly/monthly reports CONST USE_NEW_FLOORS = TRUE CONST strDailyFloor = "1r" CONST strWeeklyFloor = "5r" CONST strMonthlyFloor = "10r" CONST strYearlyFloor = "25r" '----------------------------------------+---------------------------------------- ' End of configuration '----------------------------------------+---------------------------------------- Dim objFSO Dim oShell Dim strOutputDir Dim strConfigDir Dim strConfigFile Set objFSO = CreateObject("Scripting.FileSystemObject") Set oShell = WScript.CreateObject ("WSCript.shell") 'Check for CScript If Not IsCScript() Then Wscript.echo "Analog_Run.VBS must be run with CScript." Wscript.Quit 1 End if IF Mid(OUTPUT_DIR,2,1) = ":" Then strOutputDir = OUTPUT_DIR Else strOutputDir = objFSO.BuildPath(ANALOG_ROOT_DIR , OUTPUT_DIR) End if strConfigDir = objFSO.BuildPath(ANALOG_ROOT_DIR , CONFIG_DIR) strConfigFile = objFSO.BuildPath(strConfigDir , CONFIG_FILE) 'Check for Directories If Not objFSO.FolderExists(ANALOG_ROOT_DIR) Then Wscript.echo "Analog Root Directory not found: " & ANALOG_ROOT_DIR Wscript.Quit 1 End If If RM_INSTALLED = True And Not objFSO.FolderExists(RM_ROOT_DIR) Then Wscript.echo "Report Magic Root Directory not found: " & RM_ROOT_DIR Wscript.Quit 1 End If If RDNS_ENABLED = True And Not objFSO.FileExists(RDNS_EXE) Then Wscript.echo "RDNS not found: " & RDNS_EXE Wscript.Quit 1 End If If Not objFSO.FolderExists(strConfigDir) Then Output "Analog Config Directory not found: " & strConfigDir Wscript.Quit 1 End if If Not objFSO.FileExists(strConfigFile) Then Output "Analog Config File not found: " & strConfigFile Wscript.Quit 1 End if If Not objFSO.FolderExists(strOutputDir) Then objFSO.CreateFolder (strOutputDir) If Not objFSO.FolderExists(strOutputDir) Then Output "Analog_Run Output directory not found and could not be created: " & strOutputDir Wscript.Quit 1 End if End if If Not objFSO.FolderExists(LOGFILE_ROOT_DIR) Then Output "IIS Log Directory not found: " & LOGFILE_ROOT_DIR Wscript.Quit 1 End if 'Start main processing Call Main() 'Clean up Set objFSO = Nothing Set oShell = Nothing '----------------------------------------+---------------------------------------- ' Main - ' ' Steps ' 1) Parse Command Line ' 2) Purge Log Files of URLScan lines ' 3) Run Report ' a) Figure out Date Range ' b) Create Output folder ' c) Build & run command for Analog report ' d) Build & run command for Analog report (computer output) ' e) Create RM configuration file for this date range ' f) Build & run command for ReportMagic report ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created '----------------------------------------+---------------------------------------- Sub Main() Dim strFromDate 'MM/DD/YYYY Dim strToDate 'MM/DD/YYYY Dim dtDNSCheckDate Dim iReportType '1 = Day, 2 = Week, 3 = Month, 4 = Year, 0 = Help Dim strWeek Dim strMonth Dim strDay Dim strTempDir Dim strReportDir Dim strCommand Dim strRMFile Dim strShortConfigFile Output "------------------------------------------" Output "Analog_Run.VBS at " & Now() Output "------------------------------------------" If Not ParseCommandLine(strFromDate, strToDate, iReportType) Then If iReportType <> 0 Then Output "Analog_Run.VBS - Invalid Command Line" End if wscript.echo "SYNTAX: Analog_Run.vbs " wscript.echo " /H -> This message" wscript.echo " -> Daily Report for Today" wscript.echo " /Day= -> Daily Report for Yesterday" wscript.echo " /Day=MM/DD/YYYY -> Daily Report for date" wscript.echo " /From=MM/DD/YYYY /To=MM/DD/YYYY -> Date Range Report" wscript.echo " /Week= -> Weekly Report for Yesterday" wscript.echo " /Week=MM/DD/YY -> Weekly Report for date" wscript.echo " /Month= -> Monthly Report for Yesterday" wscript.echo " /Month=MM/DD/YY -> Monthly Report for date" wscript.echo " /Year= -> Yearly Report for Yesterday" wscript.echo " /Year=MM/DD/YY -> Yearly Report for date" Exit Sub End if 'Purge URLScan lines If PURGE_URLSCAN Then Output " ------------------------------------------" Output " Purging URLScan lines..." Call Purge(LOGFILE_ROOT_DIR) Output " ------------------------------------------" End if Output " Running Analog From " & strFromDate & " to " & strToDate & "." Select Case iReportType Case 1 'Single Day Directory strReportDir = Year(strFromDate) & Get2DigitNumber(DatePart("m", strFromDate)) & Get2DigitNumber(DatePart("d", strFromDate)) If strFromDate <> strToDate Then strReportDir = strReportDir & "-" & Year(strToDate) & Get2DigitNumber(DatePart("m", strToDate)) & Get2DigitNumber(DatePart("d", strToDate)) End If Case 2 'Weekly Directory strReportDir = Year(strFromDate) & "_W" & Get2DigitNumber(DatePart("ww", strFromDate)) Case 3 'Monthly Directory strReportDir = Year(strFromDate) & Get2DigitNumber(DatePart("m", strFromDate)) Case 4 'Yearly Directory strReportDir = Year(strFromDate) End Select 'Report Output Dir strTempDir = objFSO.BuildPath(strOutputDir, strReportDir) If objFSO.FolderExists(strTempDir) Then objFSO.DeleteFolder strTempDir, True End if On Error Resume Next Output " Creating Output directory: " & strTempDir objFSO.CreateFolder strTempDir On Error Goto 0 If Not objFSO.FolderExists(strTempDir) Then Output " *** Error Creating Output directory: " & strTempDir End if 'Config File If CONFIG_DIR <> "" Then strShortConfigFile = CONFIG_DIR & "\" & CONFIG_FILE Else strShortConfigFile = CONFIG_FILE End if 'Fire up a 3rd party dns checker if that option is enabled If RDNS_ENABLED Then Dim strRDNSLog Select Case iReportType Case 1 'Single Day Directory dtDNSCheckDate = CDate(strFromDate) Do While (dtDNSCheckDate <= CDate(strToDate)) strRDNSLog = strRDNSLog & RDNS_LOG_SWITCH & CHR(34) & GetLogFileNameFromDate(dtDNSCheckDate) & CHR(34) dtDNSCheckDate = dtDNSCheckDate + 1 Loop Case 2 'Week dtDNSCheckDate = CDate(strFromDate) Do While (dtDNSCheckDate <= CDate(strToDate)) strRDNSLog = strRDNSLog & RDNS_LOG_SWITCH & CHR(34) & GetLogFileNameFromDate(dtDNSCheckDate) & CHR(34) dtDNSCheckDate = dtDNSCheckDate + 1 Loop Case 3 'Month 'Get month strRDNSLog = RDNS_LOG_SWITCH & CHR(34) & GetLogFileMonthFromDate(strFromDate) & CHR(34) Case 4 'Year 'Get Year strRDNSLog = RDNS_LOG_SWITCH & CHR(34) & GetLogFileYearFromDate(strFromDate) & CHR(34) End Select DnsCheckLogFile(strRDNSLog) End If 'Build a regular Analog command line strCommand = BuildAnalogCommandLine(strShortConfigFile, strFromDate, strToDate, strReportDir, iReportType, FALSE) Output " Running: " & strCommand On Error Resume Next oShell.run strCommand, 0, True On Error Goto 0 If RM_INSTALLED Then On Error Resume Next objFSO.CreateFolder objFSO.BuildPath(strTempDir, RM_SUBDIR) IF objFSO.FileExists(objFSO.BuildPath(ANALOG_ROOT_DIR, "stylesheet.css")) Then objFSO.CopyFile objFSO.BuildPath(ANALOG_ROOT_DIR, "stylesheet.css"), objFSO.BuildPath(objFSO.BuildPath(strTempDir, RM_SUBDIR), "stylesheet.css") End if On Error Goto 0 'Build an Analog computer file generation command line strCommand = BuildAnalogCommandLine(strShortConfigFile, strFromDate, strToDate, strReportDir, iReportType, TRUE) Output " Running: " & strCommand On Error Resume Next oShell.run strCommand, 0, True On Error Goto 0 'Run Report Magic against the Analog file strRMFile = Chr(34) & objFSO.BuildPath(objFSO.BuildPath(strOutputDir, strReportDir), "rmagic.rm") & Chr(34) If WriteRMFile(objFSO.BuildPath(strOutputDir, strReportDir) ) Then strCommand = Chr(34) & objFSO.BuildPath(RM_ROOT_DIR, "rmagic.exe") & Chr(34) strCommand = strCommand & " " & strRMFile & " -statistics_File_In=" & OUTPUT_DIR & "\" & strReportDir & "\report.dat" Output " Running: " & strCommand On Error Resume Next oShell.run strCommand, 0, True On Error Goto 0 End if End if Output "------------------------------------------" Output "END OF Analog_Run.VBS at " & Now() Output "------------------------------------------" End Sub '----------------------------------------+---------------------------------------- ' BuildAnalogCommandLine - Builds the command line for Analog, given a few input ' parameters: ' ' strShortConfigFile - analog.cfg location ' strFromDate - date range to start at ' strToDate - date range to stop at ' strReportDir - put generated files here ' iReportType - 1-Daily / 2-Weekly / 3-Monthly / 4-Yearly ' bReportMagic - TRUE to gen .dat file for RM; false for HTML ' ' Returns a string representing the command line given the above options ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 031117 EJB Created '----------------------------------------+---------------------------------------- Function BuildAnalogCommandLine(strShortConfigFile, strFromDate, strToDate, strReportDir, iReportType, bReportMagic) Dim strTemp 'Start building the command to run strTemp = Chr(34) & objFSO.BuildPath(ANALOG_ROOT_DIR, "analog.exe") & Chr(34) strTemp = strTemp & " -G +g" & Chr(34) & strShortConfigFile & Chr(34) strTemp = strTemp & " +C" & Chr(34) & "FROM " & DateFormatYYMMDD(strFromDate) & Chr(34) strTemp = strTemp & " +C" & Chr(34) & "TO " & DateFormatYYMMDD(strToDate) & Chr(34) strTemp = strTemp & " +C" & Chr(34) & "OUTFILE " & OUTPUT_DIR & "\" & strReportDir & "\Report." If bReportMagic Then strTemp = strTemp & "dat" & Chr(34) & " +C" & Chr(34) & "Output COMPUTER" & Chr(34) Else strTemp = strTemp & "html" & Chr(34) End If If RDNS_ENABLED Then strTemp = strTemp & " +C" & Chr(34) & "DNS READ" & Chr(34) End If If ADJUST_DATE_BY_GMT Then strTemp = strTemp & " +C" & Chr(34) & "LOGTIMEOFFSET " & GetGMTOffset(CDate(strFromDate)) & Chr(34) End If 'Turn Off Monthly, Weekly and Daily Select Case iReportType Case 1 strTemp = strTemp & " +C" & Chr(34) & "MONTHLY OFF" & Chr(34) & " +C" & Chr(34) & "WEEKLY OFF" & Chr(34) & " +C" & Chr(34) & "DAILYREP OFF" & Chr(34) & " +C" & Chr(34) & "DAILYSUM OFF" & Chr(34) Case 2 'Turn on Daily / Turn off Monthly and Weekly strTemp = strTemp & " +C" & Chr(34) & "DAILYSUM ON" & Chr(34) & " +C" & Chr(34) & "MONTHLY OFF" & Chr(34) & " +C" & Chr(34) & "WEEKLY OFF" & Chr(34) 'Turn On Weekly / Turn Off Monthly Case 3 strTemp = strTemp & " +C" & Chr(34) & "WEEKLY ON" & Chr(34) & " +C" & Chr(34) & "MONTHLY OFF" & Chr(34) Case 4 'Turn On Weekly and Monthly strTemp = strTemp & " +C" & Chr(34) & "WEEKLY ON" & Chr(34) & " +C" & Chr(34) & "MONTHLY ON" & Chr(34) End Select If USE_NEW_FLOORS Then Select Case iReportType Case 1 strTemp = strTemp & GetFloors(strDailyFloor) Case 2 strTemp = strTemp & GetFloors(strWeeklyFloor) Case 3 strTemp = strTemp & GetFloors(strMonthlyFloor) Case 4 strTemp = strTemp & GetFloors(strYearlyFloor) End Select End if BuildAnalogCommandLine = strTemp End Function '----------------------------------------+---------------------------------------- ' GetFloors - Returns a set of floor variables given an input ' ' floor - value to use ' ' Returns a string with the given floor value set -- dead simple string replace ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 031117 EJB Created '----------------------------------------+---------------------------------------- Function GetFloors(floor) Dim strTemp strTemp = " +C" & Chr(34) & "REQFLOOR " & floor & Chr(34) strTemp = strTemp & " +C" & Chr(34) & "ORGFLOOR " & floor & Chr(34) strTemp = strTemp & " +C" & Chr(34) & "REFFLOOR " & floor & Chr(34) strTemp = strTemp & " +C" & Chr(34) & "REFSITEFLOOR " & floor & Chr(34) strTemp = strTemp & " +C" & Chr(34) & "HOSTFLOOR " & floor & Chr(34) GetFloors = strTemp End Function '----------------------------------------+---------------------------------------- ' DnsCheckLogFile - Accepts a log file name, and runs a DNS check tool against it ' ' Uses the settings specified by the RDNS_* set of variables ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 031030 EJB Created '----------------------------------------+---------------------------------------- Sub DnsCheckLogFile(strLogsToCheck) Dim strCommand strCommand = Chr(34) & RDNS_EXE & Chr(34) strCommand = strCommand & " " & strLogsToCheck & RDNS_CACHE_SWITCH & RDNS_CACHE_FILE Output " Running: " & strCommand On Error Resume Next oShell.run strCommand, 0, True On Error GoTo 0 End Sub '----------------------------------------+---------------------------------------- ' GetLogFileNameFromDate - Finds the IIS filename for a log file based on date ' ' Returns a string representing the filename; doesn't check for existance ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 031030 EJB Created '----------------------------------------+---------------------------------------- Function GetLogFileNameFromDate(dtLogFileDate) 'IIS has 2 year date / 2 day month / 2 day day - ie. ex031028.log GetLogFileNameFromDate = objFSO.BuildPath(LOGFILE_ROOT_DIR, "ex" & Right(CStr(Year(dtLogFileDate)), 2) & Get2DigitNumber(DatePart("m", dtLogFileDate)) & Get2DigitNumber(DatePart("d", dtLogFileDate)) & ".log") End Function '----------------------------------------+---------------------------------------- ' GetLogFileMonthFromDate - Finds the IIS filename for a log file based on date ' ' Returns a string representing the filename; doesn't check for existance ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 031201 CGL Created '----------------------------------------+---------------------------------------- Function GetLogFileMonthFromDate(dtLogFileDate) 'IIS has 2 year date / 2 day month / 2 day day - ie. ex031028.log GetLogFileMonthFromDate = objFSO.BuildPath(LOGFILE_ROOT_DIR, "ex" & Right(CStr(Year(dtLogFileDate)), 2) & Get2DigitNumber(DatePart("m", dtLogFileDate)) & "*.log") End Function '----------------------------------------+---------------------------------------- ' GetLogFileYearFromDate - Finds the IIS filename for a log file based on date ' ' Returns a string representing the filename; doesn't check for existance ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 031201 CGL Created '----------------------------------------+---------------------------------------- Function GetLogFileYearFromDate(dtLogFileDate) 'IIS has 2 year date / 2 day month / 2 day day - ie. ex031028.log GetLogFileYearFromDate = objFSO.BuildPath(LOGFILE_ROOT_DIR, "ex" & Right(CStr(Year(dtLogFileDate)), 2) & "*.log") End Function '----------------------------------------+---------------------------------------- ' ParseCommandLine - Parses the command line. ' ' Returns true if valid command line, false of not. ' ' strFromDate - set to report Start ' strToDate - set to report End ' iReportType - set to report Type ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created ' 020822 CGL Added year '----------------------------------------+---------------------------------------- Function ParseCommandLine(ByRef strFromDate, ByRef strToDate, ByRef iReportType) Dim strMonth Dim strWeek Dim strTemp Dim strArg Dim strValue Dim iCount Dim bFromFound Dim bToFound Dim bWeekFound Dim bMonthFound Dim bYearFound ParseCommandLine = False 'How many arguments If Wscript.Arguments.count = 0 Then strValue = Now If Not ParseDateString(strValue) Then ParseCommandLine = False Exit Function End if strFromDate = strValue strToDate = strValue iReportType = 1 ParseCommandLine = True Else 'Command Line parameters For iCount = 0 To Wscript.Arguments.count -1 Output "Command Line arg (" & iCount & "): " & Trim(Wscript.arguments.item(iCount)) strTemp = Trim(Wscript.arguments.item(iCount)) Select Case Ucase(strTemp) 'Check for Prompt for Syntax Case "/?", "-?", "/H", "-H" iReportType = 0 ParseCommandLine = False Exit Function End Select 'OK, parms should be in the form /arg=Vaule If Instr(strTemp, "=") = 0 Then ParseCommandLine = False Exit Function End if strArg = UCASE(Left(strTemp, InStr(strTemp, "=") - 1)) strValue = Mid(strTemp, InStr(strTemp, "=") + 1) Select Case strArg Case "/FROM" If Not ParseDateString(strValue) Then ParseCommandLine = False Exit Function End if strFromDate = strValue bFromFound = True Case "/TO" If Not ParseDateString(strValue) Then ParseCommandLine = False Exit Function End if strToDate = strValue bToFound = True Case "/DAY" 'a parm of "/DAY=" uses NOW If strValue = "" Then strValue = DateAdd("d", -1, Date() ) End if 'Week Parameter is MM/DD/YYYY If Not ParseDateString(strValue) Then ParseCommandLine = False Exit Function End if strFromDate = strValue strToDate = strValue bFromFound = True bToFound = True Case "/WEEK" 'a parm of "/WEEK=" uses NOW If strValue = "" Then strValue = DateAdd("d", -1, Date() ) End if 'Week Parameter is MM/DD/YYYY If Not ParseDateString(strValue) Then ParseCommandLine = False Exit Function End if strFromDate = strValue strToDate = strValue If Not FindFirstDayOfWeek(strFromDate) Then ParseCommandLine = False Exit Function End if if not FindLastDayOfWeek(strToDate) Then ParseCommandLine = False Exit Function End if bWeekFound = True Case "/MONTH" 'a parm of "/Month=" uses NOW If strValue = "" Then strValue = DateAdd("d", -1, Date() ) End if If Not ParseDateString(strValue) Then ParseCommandLine = False Exit Function End if strFromDate = strValue strToDate = strValue If Not FindFirstDayOfMonth(strFromDate) Then ParseCommandLine = False Exit Function End if if not FindLastDayOfMonth(strToDate) Then ParseCommandLine = False Exit Function End if bMonthFound = True Case "/YEAR" 'a parm of "/Year=" uses NOW If strValue = "" Then strValue = DateAdd("d", -1, Date() ) End if If Not ParseDateString(strValue) Then ParseCommandLine = False Exit Function End if strFromDate = strValue strToDate = strValue If Not FindFirstDayOfYear(strFromDate) Then ParseCommandLine = False Exit Function End if if not FindLastDayOfYear(strToDate) Then ParseCommandLine = False Exit Function End if bYearFound = True Case Else ParseCommandLine = False Exit Function End Select Next End If 'Check for Report Type If bYearFound And Not (bWeekFound OR bMonthFound OR (bFromFound And bToFound)) Then iReportType = 4 ParseCommandLine = True End if If bMonthFound And Not (bWeekFound OR bYearFound OR (bFromFound And bToFound)) Then iReportType = 3 ParseCommandLine = True End if If bWeekFound And Not (bMonthFound OR bYearFound OR (bFromFound And bToFound))Then iReportType = 2 ParseCommandLine = True End if If (bFromFound And bToFound) AND NOT (bMonthFound OR bWeekFound OR bYearFound ) Then iReportType = 1 ParseCommandLine = True End if End Function '----------------------------------------+---------------------------------------- ' FindsFirstDayOfWeek - Finds the date of Sunday of this week. ' ' Returns true if valid date, false if invalid date ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created '----------------------------------------+---------------------------------------- Function FindFirstDayOfWeek(ByRef strDate) If Not IsDate(strDate) Then FindFirstDayOfWeek = False Exit Function End if Do Until DatePart("w", strDate) = vbSUNDAY strDate = DateAdd("d", -1, strDate) Loop FindFirstDayOfWeek = True End Function '----------------------------------------+---------------------------------------- ' FindLastDayOfWeek - Finds the date of the Saturday of this week ' ' Returns true if valid date, false if invalid date ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created '----------------------------------------+---------------------------------------- Function FindLastDayOfWeek(ByRef strDate) If Not IsDate(strDate) Then FindFirstDayOfWeek = False Exit Function End if Do Until DatePart("w", strDate) = vbSATURDAY strDate = DateAdd("d", 1, strDate) Loop FindLastDayOfWeek = True End Function '----------------------------------------+---------------------------------------- ' FindFirstDayOfMonth - Trivial ' ' Returns true if valid date, false if invalid date ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created '----------------------------------------+---------------------------------------- Function FindFirstDayOfMonth(ByRef strDate) If Not IsDate(strDate) Then FindFirstDayOfMonth = False Exit Function End if strDate = DateSerial(Year(strDate), Month(strDate), 1) FindFirstDayOfMonth = True End Function '----------------------------------------+---------------------------------------- ' FindLastDayOfMonth - Trivial ' ' Returns true if valid date, false if invalid date ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created '----------------------------------------+---------------------------------------- Function FindLastDayOfMonth(ByRef strDate) If Not IsDate(strDate) Then FindLastDayOfMonth = False Exit Function End if strDate = DateSerial(Year(strDate), Month(strDate) + 1, 0) FindLastDayOfMonth = True End Function '----------------------------------------+---------------------------------------- ' FindFirstDayOfYear - Trivial ' ' Returns true if valid date, false if invalid date ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created '----------------------------------------+---------------------------------------- Function FindFirstDayOfYear(ByRef strDate) If Not IsDate(strDate) Then FindFirstDayOfYear = False Exit Function End if strDate = DateSerial(Year(strDate), 1, 1) FindFirstDayOfYear = True End Function '----------------------------------------+---------------------------------------- ' FindLastDayOfYear - Trivial ' ' Returns true if valid date, false if invalid date ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created '----------------------------------------+---------------------------------------- Function FindLastDayOfYear(ByRef strDate) If Not IsDate(strDate) Then FindLastDayOfYear = False Exit Function End if strDate = DateSerial(Year(strDate), 12, 31) FindLastDayOfYear = True End Function '----------------------------------------+---------------------------------------- ' Get2DigitNumber - Makes sure a number is in a 2-digit format ' ' Returns a string representing a 2-digit number; i.e. 9 becomes 09 -- 11 stays 11 ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 031030 EJB Created '----------------------------------------+---------------------------------------- Function Get2DigitNumber(fromNumber) Get2DigitNumber = fromNumber If fromNumber < 10 Then Get2DigitNumber = "0" & Get2DigitNumber End if End Function '----------------------------------------+---------------------------------------- ' ParseDateString - Parses a string and makes sure it's in MM/DD/YYYY format ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created ' 020515 CGL Changed to DateSerial for International date fix '----------------------------------------+---------------------------------------- Function ParseDateString(ByRef strString) Dim strMonth Dim strDay Dim strYear 'Unfortunately, IsDate is pretty flexible, accepting 1/1 and 1/1/1 as 1/1/2001 If Not IsDate(strString) Then ParseDateString = False Exit Function Else strMonth = Month(strString) If cInt(strMonth) < 10 Then strMonth = "0" & strMonth End if strDay = Day(strString) If cInt(strDay) < 10 Then strDay = "0" & strDay End if strYear = Year(strString) 'strString = strMonth & "/" & strDay & "/" & strYear strString = DateSerial (strYear, strMonth, strDay) ParseDateString = True End if End Function '----------------------------------------+---------------------------------------- ' DateFormatYYMMDD - Returns a date formated as YYMMDD. No Error checking. ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created '----------------------------------------+---------------------------------------- Function DateFormatYYMMDD(strDate) Dim strMonth Dim strDay Dim strYear strMonth = Month(strDate) If cInt(strMonth) < 10 Then strMonth = "0" & strMonth End if strDay = Day(strDate) If cInt(strDay) < 10 Then strDay = "0" & strDay End if strYear = MID(Year(strDate),3,2) DateFormatYYMMDD = strYear & strMonth & strDay End Function '----------------------------------------+---------------------------------------- ' GetGMTOffset - Given a date, returns offset from GMT on that date (includes DST) ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 031030 EJB Created '----------------------------------------+---------------------------------------- Function GetGMTOffset(testDate) 'Read time zone offset hex value from Registry. Dim HexVal GetGMTOffset = oShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\Bias") If IsDSTDate(testDate) Then 'GetGMTOffset = oShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias") GetGMTOffset = GetGMTOffset + oShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\DaylightBias") End If 'Reg value format varies between Win9x and NT If IsArray(GetGMTOffset) Then 'Win9x uses a reversed 4 element array of Hex values. HexVal = Hex(GetGMTOffset(3)) & Hex(GetGMTOffset(2)) & Hex(GetGMTOffset(1)) & Hex(GetGMTOffset(0)) Else 'Must be a NT system. HexVal = Hex(GetGMTOffset) End If 'Convert to minutes of time zone offset. GetGMTOffset = - CLng("&H" & HexVal) End Function '----------------------------------------+---------------------------------------- ' IsDSTDate - Given a date, returns whether or not DST is on for that day ' 'Daylight Saving Time begins for most of the United States at 2 a.m. on the first Sunday of April. 'Time reverts to standard time at 2 a.m. on the last Sunday of October. 'In the U.S., each time zone switches at a different time ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 031030 EJB Created '----------------------------------------+---------------------------------------- Function IsDSTDate(testDate) If ((testDate >= GetDSTStartDate(Year(testDate))) And (testDate < GetDSTEndDate(Year(testDate)))) Then IsDSTDate = True Else IsDSTDate = False End If End Function '----------------------------------------+---------------------------------------- ' GetDSTStartDate - Given a year, returns the first US DST day (first Sunday in Apr.) ' begins @ 2AM ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 031030 EJB Created '----------------------------------------+---------------------------------------- Function GetDSTStartDate(testYear) 'Start at April 1st and work forward GetDSTStartDate = DateSerial(testYear, 4, 1) Do Until Weekday(GetDSTStartDate) = vbSunday 'tack on one day GetDSTStartDate = GetDSTStartDate + 1 Loop End Function '----------------------------------------+---------------------------------------- ' GETDSTEndDate - Given a year, returns the last US DST day (last Sunday in Oct.) ' ends @ 2AM ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 031030 EJB Created '----------------------------------------+---------------------------------------- Function GetDSTEndDate(testYear) 'Start at October 31st and work backward GetDSTEndDate = DateSerial(testYear, 10, 31) Do Until Weekday(GetDSTEndDate) = vbSunday 'tack on one day GetDSTEndDate = GetDSTEndDate - 1 Loop End Function '----------------------------------------+---------------------------------------- ' WriteRMFile - Writes out the RM config file for this report ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020306 CGL Created ' 021029 CGL Fixed Image_Dir for RM logos. ' 031030 EJB Now uses RM_IMAGE_DIR value '----------------------------------------+---------------------------------------- Function WriteRMFile(strReportDir) Dim objTS Dim strOutDir Set objTS = objFSO.OpenTextFile(objFSO.BuildPath(strReportDir, "rmagic.rm"), 8, true) strOutDir = objFSO.BuildPath(strReportDir, RM_SUBDIR) objTS.Writeline "[statistics]" objTS.Writeline "File_In = " & Replace(objFSO.BuildPath(strReportDir, "report.dat"), "\", "/") objTS.Writeline "Frame_File_Out = " & Replace(strOutDir & "/index.html", "\", "/") objTS.Writeline "Reverse_Time = 1" objTS.Writeline "Language = en" objTS.Writeline "Format= XHTML 1.0" objTS.Writeline "[reports]" objTS.Writeline "Active_Column=R" objTS.Writeline "File_Out = " & Replace(strOutDir & "/", "\", "/") objTS.Writeline "Stylesheet=stylesheet.css" objTS.Writeline "Image_Dir = " & RM_IMAGE_DIR objTS.Writeline "[QUICK]" objTS.Writeline "Rows = ALL" objTS.Writeline "[graphs]" objTS.Writeline "BG_Color = #FFFFCC" objTS.Writeline "[navigation]" objTS.Writeline "File_Out = nav.html" objTS.Writeline "Stylesheet=stylesheet.css" objTS.Writeline "[website]" 'objTS.Writeline "Title = ChristopherLewis.com" 'objTS.Writeline "Webmaster = webmaster@ChristopherLewis.com" objTS.Writeline "Base_URL = ${HU}" objTS.Close Set objTS = Nothing WriteRMFile = TRUE End Function '----------------------------------------+---------------------------------------- ' Purge - Processes all IIS logfiles (exYYMMDD.log) to remove URLScan lines and ' saves as Purged_exYYMMDD.log ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 011227 CGL Created ' 020822 CGL Fixed reprocessing of purged files. '----------------------------------------+---------------------------------------- Sub Purge(strLogDir) Dim objDir Dim colFiles Dim objFile Dim objRegExp Dim objOutFile Dim bProcess If objFSO.FolderExists(strLogDir) Then Set objDir = objFSO.GetFolder(strLogDir) Set colFiles = objDir.Files Set objRegExp = New RegExp objRegExp.Pattern = "^ex\d\d\d\d\d\d.log" objRegExp.IgnoreCase = True For Each objFile in colFiles If objRegExp.Test (objFile.Name) Then bProcess = False ' Check for Purged file If objFSO.FileExists (objFSO.BuildPath(objFile.ParentFolder, "Purged_" & objFile.Name) ) Then Set objOutFile = objFSO.GetFile( objFSO.BuildPath(objFile.ParentFolder, "Purged_" & objFile.Name) ) If DateDiff("s", objFile.DateLastModified, objOutFile.DateLastModified ) < 0 Then bProcess = true End if Else bProcess = True End if If bProcess Then Call RemoveURLScan(objFSO.BuildPath(objFile.ParentFolder, objFile.Name), objFSO.BuildPath(objFile.ParentFolder, "Purged_" & objFile.Name)) End if End If Next Set objFile = Nothing Set objRegExp = Nothing Set colFiles = Nothing Set objDir = Nothing End If End Sub '----------------------------------------+---------------------------------------- ' RemoveURLScan - Processes an IIS logfile (exYYMMDD.log) and removes all the ' lines that contain "Rejected-By-UrlScan" ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 011227 CGL Created '----------------------------------------+---------------------------------------- Sub RemoveURLScan(strInFile, strOutFile) Dim objTS Dim objTSOut Dim strLine Dim objRegExp Set objTS = objFSO.OpenTextFile(strInFile , 1, False) Set objTSOut = objFSO.CreateTextFile(strOutFile, True) Set objRegExp = New RegExp objRegExp.Pattern = "Rejected-By-UrlScan" objRegExp.IgnoreCase = True Do While Not objTS.atEndOfStream strLine = objTS.ReadLine If Not objRegExp.Test(strLine) Then objTSOut.WriteLine strLine End if Loop objTS.Close objTSOut.Close 'Clean up Set objRegExp = Nothing Set objTS = Nothing Set objTSOut = Nothing End Sub '----------------------------------------+---------------------------------------- ' IsCscript - Checks CScript vs. WScript ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 020507 CGL Created '----------------------------------------+---------------------------------------- Function IsCScript() IsCscript = False On Error Resume Next Select Case Ucase(StrReverse(Left(StrReverse(WScript.FullName), Instr(StrReverse(WScript.FullName),"\") - 1))) Case "CSCRIPT.EXE" IsCscript = True Case Else IsCscript = False End Select On Error Goto 0 End Function '----------------------------------------+---------------------------------------- ' Output - Log to screen and log file ' ' Date Name Comment ' ------ ------- ----------------------------------------------------------------- ' 010101 CGL Created '----------------------------------------+---------------------------------------- Sub Output(strString) Dim strLogFile Dim objTS strLogFile = objFSO.BuildPath(ANALOG_ROOT_DIR, "Analog_Run.log") Set objTS = objFSO.OpenTextFile(strLogFile, 8, true) Wscript.Echo strString objTS.Writeline strString objTS.Close Set objTS = Nothing End Sub '----------------------------------------+---------------------------------------- 'End of Analog_Run.vbs '----------------------------------------+----------------------------------------