Archive Exchange Logs

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Archive Exchange Logs

Logged in as: Guest

arrSession:exec spGetSession 2,16,52929

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Archive Exchange Logs
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Archive Exchange Logs - 10/23/2007 4:12:10 AM

4scriptmoni

Posts: 190
Score: 0
Joined: 5/3/2007
Status: offline

Archive .log files, 1, rar 2, move to archive, 3.delete file, make report and email it
Used for Example: To archive Exchange Logs, or IIS, STMP etc...

'Archive .log files, 1, rar 2, move to archive, 3.delete file, make report and email it
'Used for Example: To archive Exchange Logs, or IIS, STMP etc... 
'Author: Felipe Ferreira  fel.h2o(@)gmail.com
'Date: 27/09/2007, update 23/10/07
'Version: 4.0 - fix email send, total archived files,total freed space
'REQUIRES: rar.exe 
'Bug: None

'Option Explicit
'||||||||||||||||||VARIABLES!!!!!!!!!!!!!!!!!!!!!!!!!!!
Dim t1 : t1 = Timer  'time the script
dim strScriptFile : strScriptFile = WScript.ScriptFullname
dim strScriptPath : strScriptPath = Left(strScriptFile, Len(strScriptFile) - Len(WScript.Scriptname)) 
dim strfile,i, sFolder    
Dim tFiles : tfiles = 0 
Dim tSize : tSize = 0

'--------------------Email varialbes, ALSO LINES: 62-EMAIL,77-LOG FOLDER
Dim strMailServer : StrMailserver = "mail.your.com"
Dim strBody

'---------------------Get Local Computer Name
strServer = getComputerName

'---------------------Log file variables
Dim outputfile : outputfile= strScriptPath & strServer & "_Archived_" & cstr(day(now())) &"_" & cstr(Month(now()))& ".txt"
Dim o2fso : Set o2fso = CreateObject("Scripting.FileSystemObject")
Dim outFile: Set outFile = o2fso.CreateTextFile(outputfile, True)
Dim diskv1 : diskv1 = 0
Dim diskv2 : diskv2 = 0
Dim DiskVFreed : DiskVFreed = 0

strBody = "Archiving : " & strServer
strBody = strBody & vbCrlf & date & " " & time & " - Starting Archive "
outfile.writeline date & " " & time & " -  Starting Archive "

'--------------------MAIN 
Diskv1 = GetDiskFreeSpace("V")      ' GET DISK SIZE FIRST
call getFiles(strServer,7,"log")  'ARGS: SERVERNAME, HOW OLD TO ARCHIVE, EXTENSION
Diskv2 = GetDiskFreeSpace("V")      ' GET DISK SIZE AFTER

'Calculate Freed Space
DiskVFreed = diskV2 - diskV1
DiskVFreed = toMegabytes(DiskVFreed)

if tfiles <> 0 then 
   RunTime = Timer  - t1
   RunTime = Left(RunTime, 4)
   outfile.writeline  "----------------------------------------------------------"
   outfile.writeline "Done. Script Runtime: " & Runtime & " secs."    
   outfile.writeline "Archived: " & tfiles & " Files,  Liberato: " & DiskVFreed & " mb"
   outfile.writeline  "----------------------------------------------------------"
   outfile.close
   
   strBody = strBody & vbCrlf & "----------------------------------------------------------"
   strBody = strBody & vbCrlf & "Archived: " & tfiles & " Files,  Liberato: " & DiskVFreed & " mb"
'Send email only if archived was done
 strSubject = strSubject & "Archived " & strServer & " done"
 wscript.sleep 100
 IF outputfile <> "" AND STRBODY <> "" THEN
     sendmail "mail@caca.com", "monitor@caca.com","", strSubject, strBody , outputfile     
 end if
end if

wscript.quit

'-------------FUNCTIONS AND SUBS--------------------------------
Function GetFiles(sServer, iDaysOld, strExt)
On error resume next
 Dim oFSO, oFolder, oFileCollection, oFile
 Dim oFolderCollection, intFileSize, strFileName
 Set oFSO = CreateObject("Scripting.FileSystemObject")
 Set fs = CreateObject("Scripting.FileSystemObject")
 'EDIT CORRECT LOG FOLDER
 sfolder = "\\"& sServer & "\Z$\LOGS\"
 
 If (fs.FolderExists(sFolder)=false) Then  
  'wscript.echo sFolder & "  NOT FOUND!"   
  exit function
 end if  
 Set oFolder = oFSO.GetFolder(sFolder)
 'gets all files of current folder
 Set oFileCollection = oFolder.Files      
'Walk through each file in this folder collection.
 For each oFile in oFileCollection    
  If (oFile.DateLastModified < (Date() - iDaysOld)) and (UCase(right(oFile.name,3))=UCase(strExt)) Then
   strBody = strBody & vbCrlf & date & " " & time & " - Archiving: "& sServer &" ; " & oFile.Name & " ; " & toMegaBytes(oFile.Size)     
   outfile.writeline date & " " & time & " -  Archiving: "& sServer &" ; " & oFile.Name & " ; " & toMegaBytes(oFile.Size) 
   strFile = replace(ofile.name, "log", "rar")
   strPath = sfolder & "archived\" & strFile
   tSize = tSize + oFile.Size
   'CALL FUNCTION TO RAR FILE!
   execute oFile.Path , strPath        
  end if 'file is older then x days and ext check   
 next 'next file in folder

'Clean UP
 Set oFSO = Nothing
 Set oFolder = Nothing
 Set oFileCollection = Nothing
 Set oFile = Nothing
 set oFolderCollection = Nothing  
end function

function execute(strFileP,strPathP)
   on error resume next
   dim strCmd
   dim objShell : Set objShell = WScript.CreateObject("WScript.Shell")    
   '-idp No output -df Delete after finish
   strCmd = strScriptPath & "rar.exe a -df " & strPathP  & " " & strFileP
   'wscript.echo strCmd    
   Dim objExecObject : Set objExecObject = objShell.Exec(strCmd)    
   Do While objExecObject.Status <> 1        
       wscript.sleep 10000    
       'Wscript.StdOut.Write(".")        
   Loop
   
   if err.number = 0 and objExecObject.Status = 1 then         
       strBody = strBody & vbCrlf & date & " " & time &  " -  Archived : " & strFileP & " to " & strPathP & vbCrlf
       outfile.writeline date & " " & time &  " -  Archived : " & strFileP & " to " & strPathP
       outfile.writeline ""
       'Counts how many files Archived 
       tfiles = tfiles + 1        
   else
       strBody = strBody & vbCrlf & "Error Archiving file: " & strFileP & " Error : " & err.Description
       outfile.writeline "Error Archiving file: " & strFileP & " Error : " & err.Description
   end if
end function

Function toMegaBytes(bytes) 
               toMegabytes = int ((bytes / 1024) /1024) 
               toMegabytes = FormatNumber(toMegaBytes,2)
End Function

Sub SendMail(sFrom,sTo,sCC,sSub,sBody,sAttch)
   err.clear
   Set objEmail = CreateObject("CDO.Message")
   objEmail.From = sFrom
   objEmail.To = sTo
   ObjEmail.CC = sCC
   objEmail.Subject = sSub
   objEmail.Textbody = sBody
   objEmail.AddAttachment sAttch
   objEmail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
   objEmail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailServer
   objEmail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
   objEmail.Configuration.Fields.Update    
   objEmail.Send
   if err.number <> 0 then
           wscript.echo "Error sending email : " & err.descprition
           wscript.quit
       end if
end sub

Function getComputerName
'get LOCAL computername  from local variables
   Dim strcomputername
   Dim objShell : Set objShell = CreateObject("WScript.Shell")   ' Run cmds
   Set objExecObject = objShell.Exec("cmd /c echo %computername%")
   Do While Not objExecObject.StdOut.AtEndOfStream
               strcomputername = objExecObject.StdOut.ReadLine()   
               getComputerName = trim(strcomputername)
   loop
end function

Function getDiskFreeSpace(strDisk)
   'get space from Disk, using FSO not WMI, WMI=SHIT
   Set objFSO=CreateObject("Scripting.FileSystemObject")
   Set colDrives=objFSO.Drives
   For Each drive In colDrives
       If drive.IsReady and drive.driveLetter = strDisk Then        
           'iPercentFree=FormatPercent(drive.FreeSpace/drive.TotalSize)
           'WScript.Echo drive.DriveLetter & " " & iPercentFree & " FREE, or " &  toMegaBytes(drive.freespace)
           GetDiskFreeSpace = drive.freespace
       End if
   Next
end Function

_____________________________

Enterprise Microsoft Scripts
Exchange, Login/Logout Monitor,TS, Monitoring, Security, AD, etc...
http://www.xoroz.com