'Archive .log files, 1, rar 2, move to archive, 3.delete file, make report and email it
'Author: Felipe Ferreira  cac(@)gmail.com
'Date: 27/09/2007, update 23/10/07
'Version: 4.0 - fix email send, total archived files,total freed space
'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
Dim strMailServer : StrMailserver = "mail.attiva.biz"
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 "from@from.com", "monitor@coco.com","mao@coco.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")
  sfolder = "\\"& sServer & "\V$\LOGS\SMTPSVC1\"
  
  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