Tuesday, May 15, 2012

A script to archive log files older than n days to a network share

I found that the IIS and SharePoint log files on my servers were getting out of hand and consuming lots of disk space. So, I decided that it would be nice to have these files compressed and moved to a network share for archiving. The files are all text files so I have selected the PPMd compression algorithm that 7zip happens to have available. It is supposed to give 30% BETTER compression than other popular compression algorithms. This can easily be changed if you decide to modify this script to work on files other than text files. I run it from Windows Scheduler on a weekly basis.

The script assumes you are using cscript to call it. Currently it is configured to only look at files with the .log extension, but that can be easily changed. The script is recursive and will look at the directory you pass it and all sub-directories. You can specify how many days of logs to keep. This is based on the last modified date.

' Usage:
' All parameters are required
' To Move all files older than 7 days from "C:\Source\folder\name\here" to "\\destinationHost\Destination\folder\name\here"
' cscript ArchiveFiles.vbs "C:\Source\folder\name\here" "\\destinationHost\Destination\folder\name\here" 7 true

' To Copy all files older than 10 days from "C:\Source\folder\name\here" to "\\destinationHost\Destination\folder\name\here"
' cscript ArchiveFiles.vbs "C:\Source\folder\name\here" "\\destinationHost\Destination\folder\name\here" 10 false

' Original Script copied from: http://gallery.technet.microsoft.com/scriptcenter/de01e926-088f-409b-abf4-e27dbb185597#content
' Brent Vermilion: 2012-05-14: Modified to use 7zip, not use a mapped drive (only unc), is now recursive, and handles files not in sub-directory,
' and added option to keep original file.

'==================
' Parameters
'==================

' maps the parameters to variables for easier understanding
SourceFolderName = WScript.Arguments(0) 'i.e. "C:\inetpub\logs\LogFiles"    Local log file directory
DestShare = WScript.Arguments(1) ' i.e. "\\myhost\d$\Archived Logs\IIS\usbtmp8375msdev"
LogFileAge = CInt(WScript.Arguments(2)) ' i.e. 7 Log files must be older than this number of days to be archived (using "last modified" date)
DeleteOriginalAfterArchive = CBool(WScript.Arguments(3)) ' i.e. true or false

'==================
' Constants
'==================
Const PathFor7zip = "C:\Program Files\7-Zip\7z.exe"
 
'==================
' Variables
'==================

Set objShell = WScript.CreateObject ("WScript.Shell")
 
Set objFSO = CreateObject("Scripting.FileSystemObject")


counter = 0
failedCounter = 0

ProcessFolder(SourceFolderName)

' clean up
Set objFile = Nothing
Set obShell = Nothing
Set objWshNetwork = Nothing

WScript.Echo counter & " files were archived to " & DestShare
WScript.Echo failedCounter & " files FAILED during archiving process."


Function ProcessFolder(folderName)
    Set objWMIService = GetObject("winmgmts:\\")

    '==================================
    ' get files in folder
    '==================================
    strPathName = FormatPath(folderName)
    Set colFiles = objWMIService.ExecQuery("Select * from CIM_DataFile where Path = '" & strPathName & "'")
    
     '==================================
    ' loop through each file and process the ones older than n days
    '==================================
    For Each objFile in colFiles
        If objFile.Extension = "log" Then
            If WMIDateStringToDate(objFile.LastModified) < (Now() - LogFileAge) Then
                ProcessFile objFile, folderName
            End If
        End If
    Next
 
     '=====================================================================================
    ' Connect to local WMI service and get a collection of subfolders for current folder
    '=====================================================================================

    Set colSubfolders = objWMIService.ExecQuery _
        ("Associators of {Win32_Directory.Name='" & folderName & "'} " _
            & "Where AssocClass = Win32_Subdirectory " _
                & "ResultRole = PartComponent")
               
    '=============================================
    ' loop through the sub-folders
    '=============================================
    For Each objFolder in colSubfolders
        ' recursive call
        ProcessFolder(objFolder.Name)
    Next
 

               
End Function
 

Function ProcessFile(objFile, folderName)

    '=================================================
    ' Check if current folder exists on remote system
    ' If not, create it
    '=================================================
    If Not objFSO.FolderExists(DestShare) Then
        CreateDirs(DestShare)
    End If

    '========================================================
    ' Compress file
    ' chr(34) adds ASCII quotes in case path contains spaces
    '========================================================
    matchBasePathIdx = InStr(1,objFile.Name, folderName, 1)
   
    ' get the path and name of the file without the base directory path
    relativeFilename = Mid(objFile.Name, matchBasePathIdx + Len(folderName) + 1)
   
    ' prepend the mapped drive and the base path on the drive we want to write to
    zipFilename = DestShare & "\" & relativeFilename  & ".7z"
   
    ' build the command line
    ' Notice we are using 7zip and the PPMd compression algorithm (-m0=PPMd) that is superior by approx 30% over other modern compression algorithms FOR TEXT.
    ' If you are not compressing text files you may leave off or change this parameter.
    ' More Info on PPMd Compression:
http://www.dotnetperls.com/ppmd
    cmdText = chr(34) & PathFor7zip & chr(34) & " a -t7z " & chr(34) & zipFilename & chr(34) & " " & chr(34) & objFile.Name & chr(34) + " -m0=PPMd"
   
    ' execute the command we built up
    compressReturn = objShell.run (cmdText,0,true)

    '========================================================
    ' Make sure the current file was compressed successfully
    ' If so, delete the file from the source directory
    '========================================================
    If compressReturn = 0 Then
      
        ' Delete the file if it succeeded and we are configured to do so
        if DeleteOriginalAfterArchive = true Then
            WScript.Echo "Deleted: " & objFile.Name
           
            ' Check if file exists to prevent error
            If objFSO.FileExists(objFile.Name) Then
                objFSO.DeleteFile objFile.Name
            End If
           
        End If
       
        counter = counter + 1
        WScript.Echo "SUCCEEDED: " + objFile.Name
    else
        failedCounter = failedCounter + 1
        WScript.Echo "FAILDED: " + objFile.Name & " -> " & zipFilename
    End If

End Function
 
 
Function FormatPath(strFolderName)
'===========================================================================
' Formats strFolderName to add extra backslashes for CIM_DataFile WQL query
' Stolen from TechNet Script Center
'===========================================================================
    arrFolderPath = Split(strFolderName, "\")
    strNewPath = ""
    For i = 1 to Ubound(arrFolderPath)
        strNewPath = strNewPath & "\\" & arrFolderPath(i)
    Next
    FormatPath = strNewPath & "\\"
End Function
 
 
Function WMIDateStringToDate(dtmDate)
'===================================================
' Formats a WMI date string to a usable Date format
' Stolen from TechNet Script Center
'===================================================

    WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
    Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
    & " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function
 
 
' Copied from:
http://www.robvanderwoude.com/vbstech_folders_md.php
' Examples:
' UNC path
'CreateDirs "\\MYSERVER\D$\Test01\Test02\Test03\Test04"
' Absolute path
'CreateDirs "D:\Test11\Test12\Test13\Test14"
' Relative path
'CreateDirs "Test21\Test22\Test23\Test24"
Sub CreateDirs( MyDirName )
' This subroutine creates multiple folders like CMD.EXE's internal MD command.
' By default VBScript can only create one level of folders at a time (blows
' up otherwise!).
'
' Argument:
' MyDirName   [string]   folder(s) to be created, single or
'                        multi level, absolute or relative,
'                        "d:\folder\subfolder" format or UNC
'
' Written by Todd Reeves
' Modified by Rob van der Woude
'
http://www.robvanderwoude.com

    Dim arrDirs, i, idxFirst, objFSO, strDir, strDirBuild

    ' Create a file system object
    Set objFSO = CreateObject( "Scripting.FileSystemObject" )

    ' Convert relative to absolute path
    strDir = objFSO.GetAbsolutePathName( MyDirName )

    ' Split a multi level path in its "components"
    arrDirs = Split( strDir, "\" )

    ' Check if the absolute path is UNC or not
    If Left( strDir, 2 ) = "\\" Then
        strDirBuild = "\\" & arrDirs(2) & "\" & arrDirs(3) & "\"
        idxFirst    = 4
    Else
        strDirBuild = arrDirs(0) & "\"
        idxFirst    = 1
    End If

    ' Check each (sub)folder and create it if it doesn't exist
    For i = idxFirst to Ubound( arrDirs )
        strDirBuild = objFSO.BuildPath( strDirBuild, arrDirs(i) )
        If Not objFSO.FolderExists( strDirBuild ) Then
            objFSO.CreateFolder strDirBuild
        End if
    Next

    ' Release the file system object
    Set objFSO= Nothing
End Sub

No comments: