stevem2k

I got bored with the lack of any proper archiving within IIS and so modified some code I found down the back of the sofa so it actually works correctly.

Save it as archive.vbs and call it from a scheduled task every night.

Requires command line 7zip to be installed


Enjoy

Steve

David_Wallis

Saved

ids

Heres one I use - again found under an old rotting beige box

Works for me and needs no additional files.... dosent delete them but zips them up over a certain age into cabs....

<snip>
' http://support.microsoft.com/support.../Q176/8/10.asp

Option Explicit
Const GENERAL_FAILURE = 2
Dim ArgObj, Servername, WebSiteID, WebSite, WebSitepath, MaxAgeOfFileToKeep
Dim Archivefolder, UseSpecificArchiveFolder
Const WinDir = "%WinDir%"
Function CreateFolderIfItDoesNotExist(FolderName)
Dim FSO
Set fso = CreateObject("Scripting.FileSystemObject")
if (fso.FolderExists(FolderName) = false) then
fso.CreateFolder(FolderName)
WScript.Echo "Archive folder created: " & FolderName
end if
Set Fso = nothing
End Function
Function RenameFile(oldName, newName)
Dim FSO, File
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.GetFile(oldName)
file.Name = newName
Set Fso = nothing
End Function
function ExpandPath(Path)
Dim key, ShellObject
if (left(Path, 8) = WinDir) then
Set ShellObject = WScript.CreateObject("WScript.Shell")
Key = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\PathName"
ExpandPath = ShellObject.RegRead(Key) & mid(Path,9)
Set ShellObject = Nothing
else
ExpandPath = Path
end if
end function
Function ReturnArchiveFileSize(FSO, CabFilename)
Dim FileObj
if (FSO.FileExists(CabFilename) = false) then
ReturnArchiveFileSize = 0
else
Set FileObj = fso.GetFile(CabfileName)
ReturnArchiveFileSize = FileObj.Size
set FileObj = Nothing
end if

end function
Function ArchiveThisFile(Filename)
Filename = lcase(filename)
if (right(Filename,4) = ".log") then
ArchiveThisFile = true
else
ArchiveThisFile = false
end if
end function
function FixNumber(Value, Length)
const Zeros = "0000"
if (Length-len(Value) > 0) then
FixNumber = Left(Zeros, Length-len(Value)) & Value
else
FixNumber = value
end if
end function
Function ReturnDatetime
Dim AMPM
if (Hour(TIME) < 12) then
AMPM = "AM"
else
AMPM = "PM"
end if
ReturnDatetime = FixNumber(Day(Date),2) & MonthName(Month(Date),true) & FixNumber(Year(Date),4) & "_" & _
FixNumber(Hour(Time),2) & FixNumber(Minute(Time),2) & FixNumber(Second(Time),2) & AMPM
end function
Function ArchiveOldLogFiles(WebSite, WebSiteLogPath, MaxAgeOfFile)
Dim File, ServerObj, FSO, FolderObj, FileObj, LogFileDir, Archived, Status, FailedToArchive
Dim Filespec, OriginalLogfilename, CabFilename, LogFileSize, ArchiveFileSize, FilesArchived
Dim CabFileSpec, CabFilesize, ReturnCode, WshShell, ArchivePercentage, Command, NewFilename
LogFileSize = 0
ArchiveFileSize = 0
Archived = 0
FailedToArchive= 0
'on error resume next

' Attempt to get the web site object from the metabase
Err.clear
Set ServerObj = GetObject(WebSite)
If (Err.Number <> 0) Then
WScript.Echo "Error: " & Err.Description & " (" & Err.Number & ")"
Exit Function
end if
LogFileDir = ExpandPath(ServerObj.LogFileDirectory & "\" & WebSiteLogPath)
WScript.Echo "Log file dir for: " & ServerObj.LogFileDirectory & " = " & WebSiteLogPath
Set ServerObj = Nothing
WScript.Echo "Log file dir for: " &WebSite & " = " & LogFileDir
Set FSO = CreateObject("Scripting.FileSystemObject")
' Check if the log file directory exists
if (FSo.FolderExists(LogFileDir) = false) then
WScript.Echo "Log file directory does not exist: " & LogFiledir
Exit Function
end if
set Folderobj = FSO.GetFolder(LogFileDir)
for each File in Folderobj.files
if (ArchiveThisFile(File.Name) = true) then
if (Date - File.DateLastModified > cint(MaxAgeOfFile)) then
OriginalLogfilename = file.name
LogFileSize = LogFileSize + File.Size
Status = "Archiving File: " &File.name & ", Age="& _
formatNumber(Date-File.DateLastModified, 0) & " days, Status="
Err.Clear
if (UseSpecificArchiveFolder = false) then
Filespec = LogFileDir & "\" & File.Name
CabFileName = left(file.name, len(File.name)-3) + "cab"
CabFileSpec = LogFileDir & "\" & CabFileName
else
NewFilename = WebSiteLogpath & "_" & ReturnDateTime & "_" & File.name
CabFilename = left(NewFilename, len(NewFilename)-3) + "cab"
CabFileSpec = ArchiveFolder & "\" & CabFileName
call RenameFile(LogFileDir & "\" & File.Name, NewFilename)
Filespec = LogFileDir & "\" & NewFilename
end if
Set WshShell = WScript.CreateObject("WScript.Shell")
' http://msdn.microsoft.com/scripting/...c/wsMthRun.htm
Command = "makecab " & chr(34) & Filespec & chr(34) & " " & chr(34) & CabFileSpec & chr(34)
ReturnCode = WshShell.Run(Command, 7, True)
If (Err.Number <> 0) Then
Status = Status & "Failed : "& Err.Description & " (" & Err.Number & ")"
FailedToArchive = FailedToArchive +1
elseif (ReturnCode <> 0) then
Status = Status & "Failed : Return code from MAKECAB.EXE was " & ReturnCode
FailedToArchive = FailedToArchive +1
else
Status = Status & "Archived " & OriginalLogfilename & " to " & CabFilename
CabFilesize = ReturnArchiveFileSize(FSO, CabFileSpec)
' This is just a sanity check to make sure the archive was created successfully.
if (File.Size > 0) and (CabfileSize > 0) and (CabFilesize <> File.Size) then
FSO.DeleteFile(Filespec)
If (Err.Number <> 0) Then
Status = Status & ", Failed to delete original log file : "& _
Err.Description & " (" & Err.Number & ")"
end if
end if
ArchiveFileSize = ArchiveFileSize + CabFilesize
Archived = Archived + 1
end if
WScript.Echo Status
end if
end if
next
ArchiveOldLogFiles = Archived
WScript.Echo "-------------------------------------------------------------------------"
if (FailedToArchive > 0) then
WScript.Echo "There were " & FailedToArchive & " files that could not be archived!"
end if
if (LogFileSize =0) then
ArchivePercentage = "0%"
else
ArchivePercentage = FormatNumber(100-((ArchiveFileSize / LogFileSize) * 100), 2) &"%"
end if
WScript.Echo Archived & " log files archived, original = " & LogFileSize & ", archived = " & ArchiveFileSize & _
" saving " & LogFileSize - ArchiveFileSize & " bytes or " & ArchivePercentage
end function
Sub DisplayHelpMessage()
WScript.Echo
WScript.Echo "Usage:"
WScript.Echo " ArchiveOldWebSiteLogfiles.VBS MaxDays [-A ArchiveFolder]"
WScript.Echo
WScript.Echo "MaxDays = If a file is older than this it will be archived."
WScript.Echo
WScript.Echo "ArchiveFolder = Optional parameter that specifies the location"
WScript.Echo " where the .CAB files get written. When using this option two"
WScript.Echo " major things happen. The CAB filename and the log filename"
WScript.Echo " are built using this format SI_D_T_O where"
WScript.Echo
WScript.Echo " S=Service such as W3SVC, MSFTPSVC"
WScript.Echo " I=Instance such as 1 for default web site"
WScript.Echo " D=Current Date"
WScript.Echo " T=Current Time"
WScript.Echo " O=Original log filename"
WScript.Echo
WScript.Echo " ex010423.log becomes W3SVC1_19May2001_085937AM_ex010423.log"
WScript.Echo
WScript.Echo "Example: cscript ArchiveOldWebSiteLogfiles.VBS 50"
WScript.Echo
WScript.Echo "This script will archive the LOG files in all WEB and FTP sites into a .CAB"
WScript.Echo "file. You can extract the files from the CAB file by using the EXTRACT command"
WScript.Echo "which is included with Windows."
WScript.Echo
WScript.Echo "Note: The original log file is deleted"
WScript.Echo
WScript.Echo "Please visit and support : http://www.iisfaq.com"
end sub

Sub DoWork(Service, ClassName)
Dim IISObj, Object, ServicePath
ServicePath = "IIS://" & ServerName & "/" & Service
Set IISOBJ = GetObject(ServicePath)
if (err <> 0) then
WScript.Echo "Failed to read service " & Service & " for path " & Servicepath & " : " & _
Err.Description & " (" & Err.Number & ")"
exit sub
end if
for each object in IISOBJ
if (Object.Class = ClassName) then
WScript.echo "Site = " & Object.Name & " - " & Object.ServerComment
WebSitepath = "IIS://" & Servername &"/"& Service & "/" & Object.Name
Call ArchiveOldLogFiles(WebSitePath, Service & Object.Name, MaxAgeOfFileToKeep)
WScript.Echo
end if
next
Err.Clear
Set IISOBJ=Nothing
end sub
Sub CheckCommandLine()
Dim OArgs, ArgNum
Set oArgs = WScript.Arguments
ArgNum = 0
UseSpecificArchiveFolder = false
ArchiveFolder = ""
If oArgs.Count < 1 Then
DisplayHelpmessage
WScript.Quit (GENERAL_FAILURE)
End If
While ArgNum < oArgs.Count
if (ArgNum = 0) then
MaxAgeOfFileToKeep = trim(oArgs(0))
else
Select Case LCase(oArgs(ArgNum))
Case "-a":
if (ArgNum+1 >= oArgs.Count) then
Call DisplayHelpmessage
WScript.Quit (GENERAL_FAILURE)
else
ArgNum = ArgNum+1
ArchiveFolder = oArgs(ArgNum)
' Strip off the last slash if provided.
if (right(ArchiveFolder,1) = "\") then
ArchiveFolder = left(ArchiveFolder, len(ArchiveFolder)-1)
end if
CreateFolderIfItDoesNotExist(ArchiveFolder)
WScript.Echo "Using archive folder : " & ArchiveFolder
UseSpecificArchiveFolder = true
end if
Case "--help","-?":
Call DisplayHelpmessage
WScript.Quit (GENERAL_FAILURE)
Case Else:
WScript.Echo "Unknown argument : "& oArgs(ArgNum)
Call DisplayHelpmessage
WScript.Quit (GENERAL_FAILURE)
End Select
end if
ArgNum = ArgNum + 1
Wend
end sub
CheckCommandLine()
Servername = "LocalHost"
WScript.Echo "Archive files over "& MaxAgeOfFileToKeep & " days old." & vbcrlf
'on error resume next

DoWork "SMTPSVC", "IIsSmtpServer"
DoWork "W3SVC", "IIsWebServer"
DoWork "MSFTPSVC", "IIsFtpServer"
DoWork "NNTPSVC", "IIsNntpServer"

</snip>