'******************************************************************************
'** NAME: FileScan.vbs
'**
'** AUTHOR: Simon Gregory, CSC at Alcoa
'** DATE  : 15/07/2005
'**
'** COMMENT: ver 1.1 - Fixed issue with handling file count of 0. (11/08/2005)
'******************************************************************************
Option Explicit
'On Error Resume Next

'******************************************************************************
'** Constants returned by File.Attributes
'******************************************************************************
Const FileAttrNormal   = 0
Const FileAttrReadOnly = 1
Const FileAttrHidden = 2
Const FileAttrSystem = 4
Const FileAttrVolume = 8
Const FileAttrDirectory = 16
Const FileAttrArchive = 32 
Const FileAttrAlias = 1024
Const FileAttrCompressed = 2048

'******************************************************************************
'** Constants for opening files
'******************************************************************************
Const OpenFileForReading = 1 
Const OpenFileForWriting = 2 
Const OpenFileForAppending = 8

'******************************************************************************
'** MOM 2005 ScriptContext.CreateEvent constants
'******************************************************************************
Const EVENT_TYPE_SUCCESS = 0
Const EVENT_TYPE_ERROR   = 1
Const EVENT_TYPE_WARNING = 2
Const EVENT_TYPE_INFORMATION = 4
Const EVENT_TYPE_AUDITSUCCESS = 8
Const EVENT_TYPE_AUDITFAILURE = 16

'******************************************************************************
'** General Variables
'******************************************************************************
Dim objFSO, objFiles, objFolder
Dim objParameters, objEvent
Dim rootDir, fileSpec
dim fileCount, fileCountFLG
Dim fileAge, fileAgeFLG
Dim fileSize, fileSizeFLG
Dim strEventMsg, tmpFile, tmpFileC, aryFiles()
Dim fSize, fDate, fName, iCount, nDate, fileFoundFLG
ReDim aryFiles(0)

'******************************************************************************
'** Our basic sub procedures
'******************************************************************************
Sub GetFileList()
	iCount = 0
	fileFoundFLG = false
	For Each tmpFile In objFiles
		If CompareFileName(tmpFile.Name,fileSpec) Then
			fName = tmpFile.Name
			fSize = tmpFile.Size / 1024
			fDate = tmpFile.DateLastModified
			If iCount > UBound(aryFiles) Then ReDim Preserve aryFiles(iCount)
			aryFiles(UBound(aryFiles)) = Array(fName,fSize,fDate)
			iCount = iCount + 1
			fileFoundFLG = true
		End if
	next
End Sub

Sub CheckFileCount()
	fileCountFLG = UBound(aryFiles)	+ 1
End Sub

Sub CheckFileAge()
	iCount = 0
	nDate = now
	For iCount = 0 To UBound(aryFiles)
		If DateDiff("n",aryFiles(iCount)(2),nDate) > Clng(fileAge) Then
			fileAgeFLG = fileAgeFLG & aryFiles(iCount)(0) & " "
		end if
	Next
End Sub

Sub CheckFileSize()
	iCount = 0
	For iCount = 0 To UBound(aryFiles)
		If aryFiles(iCount)(1) > Clng(fileSize) Then
			fileSizeFLG = fileSizeFLG & aryFiles(iCount)(0) & " "
		End if
	next
End Sub

Sub ProcessResults()
	If clng(fileCount) < clng(fileCountFLG) Then
		strEventMsg = strEventMsg & "File count of " & fileCountFLG & " is > " & fileCount & " : "
	End If

	If Len(fileAgeFLG) > 1 Then
		strEventMsg = strEventMsg & "File age of file(s) (" & fileageFLG & ") is > " & fileAge & " mins old : "
	End If

	If Len(filesizeflg) > 1 Then
		strEventMsg = strEventMsg & "File size of file(s) (" & fileSizeFLG & ") is > " & fileSize & "Kb(s)"
	End If
End Sub

Sub GenerateEvent()
	If Len(strEventMsg) > 0 and strEventMsg <> "No Files Found." then
		objEvent.Message = "File Scan Critical - "& objEvent.LoggingComputer & " - looking for " & rootDir & filespec & " - " & strEventMsg
		objEvent.EventNumber = "30666"
		objEvent.EventType = EVENT_TYPE_ERROR
		objEvent.EventSource = "FileScan"
		ScriptContext.Submit objEvent
	ElseIf strEventMsg = "No Files Found." Then
		objEvent.Message = "Informational - from "& objEvent.LoggingComputer & " - looking for " & rootDir & filespec & " - " & strEventMsg
		objEvent.EventNumber = "30303"
		objEvent.EventType = EVENT_TYPE_INFORMATION
		objEvent.EventSource = "FileScan"
		ScriptContext.Submit objEvent
	Else
		objEvent.Message = "Success - from "& objEvent.LoggingComputer & " - looking for " & rootDir & filespec & " - passed all checks."
		objEvent.EventNumber = "30202"
		objEvent.EventType = EVENT_TYPE_INFORMATION
		objEvent.EventSource = "FileScan"
		ScriptContext.Submit objEvent
	End if
End sub

'******************************************************************************
'** CompareFileName and CompareFileName2 functions were grafted from 
'** http://www.source-code.biz/snippets/vbscript/1.htm
'** Many thanks to their origional author: Christian d'Heureuse
'******************************************************************************
Private Function CompareFileName (ByVal Name, ByVal Filter) ' (recursive)
	CompareFileName = False
	Dim np, fp
	np = 1
	fp = 1
	Do
		If fp > Len(Filter) Then
			CompareFileName = np > len(name)
			Exit Function
		End if
		If Mid(Filter,fp) = ".*" Then       ' special case: ".*" at end of Filter
			If np > Len(Name) Then
				CompareFileName = True
				Exit Function
			End if
		End If
		Dim fc
		fc = Mid(Filter,fp,1)
		fp = fp + 1
		Select Case fc
			Case "*"
				CompareFileName = CompareFileName2(name,np,filter,fp)
				Exit Function
			Case "?"
				If np <= Len(Name) And Mid(Name,np,1) <> "." Then np = np + 1
			Case Else
				If np > Len(Name) Then Exit Function
				Dim nc: nc = Mid(Name,np,1)
				np = np + 1
				If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
		End Select
	Loop
End Function

Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter, ByVal fp0)
	Dim fp
	fp = fp0
	Dim fc2
	Do
		If fp > Len(Filter) Then
			CompareFileName2 = True
			Exit Function
		End if
		If Mid(Filter,fp) = ".*" Then    ' special case: ".*" at end of Filter
			CompareFileName2 = True
			Exit Function
		End If
		fc2 = Mid(Filter,fp,1): fp = fp + 1
		If fc2 <> "*" And fc2 <> "?" Then Exit Do
	Loop
	Dim np
	For np = np0 To Len(Name)
		Dim nc
		nc = Mid(Name,np,1)
		If StrComp(fc2,nc,vbTextCompare)=0 Then
			If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
				CompareFileName2 = True: Exit Function
			End If
		End If
	Next
	CompareFileName2 = False
End Function

'******************************************************************************
'** Ah Main... the root of all evil and the default sub procedure.
'******************************************************************************
Sub Main()
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objParameters = ScriptContext.Parameters
	Set objEvent = ScriptContext.CreateEvent
	
	rootDir = objParameters.get("Root_Dir")
	fileSpec = objParameters.get("File_Spec")
	fileCount = objParameters.get("Max_File_Count")
	fileAge = objParameters.Get("File_Age")
	fileSize = objParameters.Get("Max_File_Size")
	
	If Right(rootDir,1) <> "\" Then rootDir = rootDir & "\"
	
	'Check that we can see the root directory...
	On Error Resume next
	set objFolder = objFSO.GetFolder(rootDir)
	If Err.Number > 0 Then
		objEvent.Message = "Cannot find directory " & rootDir & " on " & objEvent.LoggingComputer
		objEvent.EventNumber = "30404"
		objEvent.EventType = EVENT_TYPE_ERROR
		objEvent.EventSource = "FileScan"
		ScriptContext.Submit objEvent
		ScriptContext.Quit
	Else
		set objFiles = objFolder.Files
	End If
	On Error goto 0
	
	'Set flags and assume all is good till otherwise noted...
	fileCountFLG = 0
	fileAgeFLG = ""
	fileSizeFLG = ""
	strEventMsg = ""
	
	'If we find files process them.
	If objFiles.Count > 0 Then
		Call GetFileList()
		If fileFoundFLG = False Then
			strEventMsg = "No Files Found."
			Call GenerateEvent()
		else
			'If a parameter is provided, run the check for it...
			If clng(fileCount) > 0 Then Call CheckFileCount()
			If clng(fileAge) > 0 Then Call CheckFileAge()
			If clng(fileSize) > 0 Then Call CheckFileSize()
			Call ProcessResults()
			Call GenerateEvent()
		End if
	End if
	'Process our results and generate an alert for either good or bad.
	ScriptContext.Quit
End Sub