Clean Servers

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Clean Servers

Logged in as: Guest

arrSession:exec spGetSession 2,16,50961

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

Printable Version

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

Page: [1]

Message

<< Older Topic Newer Topic >>

Clean Servers - 8/19/2007 8:59:06 PM

4scriptmoni

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

freed over 200GB of our servers C disk.
Does a really good Loging!
Logs: 3 separeted files, one of all deleted files, one just warnings, one for general space freed

Set parameters according to your enviroment:
Checks and Deletes profiles older then X days
'Delete any (dump files) .dmp on folders c:\windows c:\windows\temp c:\windows\minidump
'Delete any temp files on folders c:\windows\temp or c:\temp older then X days
'Delete Perfmon files on folder c:\perflogs older then X days
'WARN: about any profiles larger then X mb, or C: disk with less then X free space

Requires delprof.exe from ResourceKit.

'Script to cleanup space of Disk C: on List of Servers
'Author: Felipe Ferreira
'Version: 4.0
'Date: 1/04/07, updated 10/08/2007

'Checks and Deletes profiles older then X days
'Delete any (dump files) .dmp on folders c:\windows c:\windows\temp c:\windows\minidump
'Delete any temp files  on folders c:\windows\temp or  c:\temp older then X days
'Delete  Perfmon files on folder c:\perflogs older then X days
'WARN: about any profiles larger then X mb, or C: disk with less then X free space
'Logs: 3 separeted files, one of all deleted files, one just warnings, one for general space freed

'TODO: delete *.hdmp inside users profiles, When POPUP Dont Send to MS

Option Explicit

'@@@@@@@@@@@@  EDIT HERE @@@@@@@@@@@@@@@
Dim intProfileDays : intProfileDays = 180     'Profile Old days, 6 months
Dim intMaxProfile : intMaxProfile = 900000000 'Max Profile Size (warn), 900mb
Dim intMinFree : intMinFree = 5000000000       'NOT WORKING Min FreeSize Disk(warn)  , 5GB
Dim intTimeOut : intTimeOut = 180               'Timeout (Seconds) for deleting profiles, 3 minutes
'@@@@@@@@@@@@  EDIT HERE @@@@@@@@@@@@@@@

Dim iFSO : Set iFSO = CreateObject("Scripting.FilesyStemObject")
Dim oFSO : Set oFSO = CreateObject("Scripting.FilesyStemObject")

Dim value1, value2, value3
Dim Computer, strFolder,strFolder2,strFolder3, free, TFree, TTFile, TFile,TTFile2
Dim Outputfile, Outputfile2, Outputfile3, Inputfile, ofile, ofile2,ofile3, ifile, objLogicalDisk,TotalFree,TotalFiles
Dim strScriptFile, strScriptPath, strProfile,strPingit
Dim t1, runtime
t1 = Timer  'time the script
free = 0
strScriptFile = WScript.ScriptFullname
strScriptPath = Left(strScriptFile, Len(strScriptFile) - Len(WScript.Scriptname)) 'used to define the path from where the script file is located

inputfile = strScriptPath & "servers.txt"
Outputfile = strScriptPath & "logs_Total.txt"
Outputfile2 = strScriptPath & "logs_Warnings.txt"
Outputfile3 = strScriptPath & "logs_FilesDeleted.txt"

Const ForAppending = 8 
Set ofile = oFso.OpenTextFile(Outputfile, ForAppending, TRUE)
Set ofile2 = oFSo.OpenTextFile(Outputfile2, ForAppending, TRUE)
Set ofile3 = oFSo.OpenTextFile(Outputfile3, ForAppending, TRUE)
Set ifile = iFSO.OpenTextFile(inputfile)

oFile.Writeline "#################START##################"
oFile.Writeline "Script: " & strScriptFile & "  started in " & Date & " at " & Time & VbCrLf
oFile.Writeline "Server Name, Space Freed (MB), Files Deleted, Disk C: Space "

oFile2.Writeline "#################START##################"
oFile2.Writeline "Script: " & strScriptFile & "  started in " & Date & " at " & Time & VbCrLf

oFile3.Writeline "#################START##################"
oFile3.Writeline "Script: " & strScriptFile & "  started in " & Date & " at " & Time & VbCrLf
ofile3.writeline "Computer\Path\Filename        ,     File Size (Kb) ,   Last Modified"

'Start to read the inputfile and goes thru each line
Do until ifile.AtEndOfLine
  Computer = ifile.ReadLine
  'Checks if Computer is UP
  strPingit = true
  GetStatus Computer    
 if strPingit = true then
 on error resume next
  'get space from C drive
  Dim objWMIService : Set objWMIService = GetObject("winmgmts://" & Computer)  
  Dim colLogicalDisk : Set colLogicalDisk = objWMIService.InstancesOf("Win32_LogicalDisk")  
  For Each objLogicalDisk In colLogicalDisk  
     if objLogicalDisk.drivetype=3 then 
  'get Only C: 
           if objLogicalDisk.DeviceID = "C:" then
                  value1 = toMegaBytes(objLogicalDisk.freespace)
                  Wscript.Echo "Server: " & Computer & " and Disk  " & objLogicalDisk.DeviceID & " Free Space = " & value1 & " MB"
                  
           end if
     end if
  Next

TFree = 0
  TTFile = 0  'only dmp
  TTFile2 = 0    'others
  
  wscript.echo "Deleteing Old profiles"
  DeleteProfile computer
  Wscript.Echo VbCrLf & "Deleting Temp and PerfLogs Files"
  DeleteOldFile  "\\" & Computer & "\c$\windows\temp", 1    'SLOW delete TEMP files older then 1 day old
  DeleteOldFile  "\\" & Computer & "\c$\PerfLogs", 60       'delete performance trace files older then 2 motnhs
  DeleteOldFile  "\\" & Computer & "\c$\temp", 1               'delete TEMP files older then 1 day old
  
  Wscript.Echo  VbCrLf & "Deleting Dump Files"
  DeleteFile "\\" & Computer & "\c$\windows" 
  DeleteFile "\\" & Computer & "\c$\windows\temp"  
  DeleteFile "\\" & Computer & "\c$\windows\minidump"
  
  
  'search for large profiles
  Wscript.Echo "Scanning For Large Profiles"
  call CheckFolder("C:\Documents and Settings\",computer)
   
  'Get again the space of C: drive to Compare Freed Space and print to log
  Set objWMIService = GetObject("winmgmts://" & Computer)  
  Set colLogicalDisk = objWMIService.InstancesOf("Win32_LogicalDisk")

For Each objLogicalDisk In colLogicalDisk  
     if objLogicalDisk.drivetype=3 then 
  'get Only C: 
           if objLogicalDisk.DeviceID = "C:" Then
                   value2 = toMegaBytes(objLogicalDisk.freespace)    
                   value3 = value2 - value1
                  wscript.echo "Freed: " & FormatNumber(value3,2) & " MB"
                  wscript.echo "Deleted: " & TTFile + TTFile2 & " files."
                  Wscript.echo "#->Server Cleaned: " & Computer & " Drive " & objLogicalDisk.DeviceID & " has " & value2 & " MB"
                   free = value3 + free 'Counter Total Freed
                  'If less then 5GB free WARN
                  if objLogicalDisk.freespace < 5000000000  then 
                      ofile2.writeline  Computer & " C:( " & value2 & " MB) has less then " & toMegaBytes(intMinFree) & " MB"
                      wscript.echo "##WARNING: " & Computer & " C:( " & value2 & " MB)has less then  " & toMegaBytes(intMinFree) & " MB"
                  end if    
                  ofile.writeline Computer & " , " & FormatNumber(value3,2) & " , " &  TTFile + TTFile2 & " , " & value2
                     wscript.echo "#-----------------------------------------------------------------#"
            end if
     end if
  Next

'Calculate Grand TOTAL
  TotalFree = TotalFree + Free
  TotalFiles = TotalFiles + TTFile
  TotalFiles = TotalFiles + TTFile2
 end if 'getstatus end if (ping)
Loop 'go to next computer in list

'Calculate Total Run Time and Format
RunTime = Timer  - t1
RunTime = Left(RunTime, 4)
RunTime = RunTime / 60
RunTime = Left(RunTime, 4)
ofile.writeline "------------------------------------------------"
ofile.writeline "Total Files Deleted: " & TotalFiles
ofile.writeline "Total Space Deleted: " & FormatNumber(TotalFree,2) & " MB "
oFile.WriteLine "Command Completed in: " & RunTime & " minutes"
ofile.writeline "#################END##################" & VbCrLf

Wscript.echo "Total Files Deleted: " & TotalFiles
Wscript.echo "Total Space Deleted: " & FormatNumber(TotalFree,2) & " MB "
Wscript.Echo "The scripts has finished, logs at " & strScriptPath
wscript.echo "Command Completed in: " & RunTime & " minutes"

'cleanup
ofile.close
ofile2.close
ofile3.close

'-#####################-----FUNCTIONS AND SUBS-------##############################
Function toGigaBytes(bytes) 
              toGigabytes = int (((bytes / 1024) /1024) / 1024) 
End Function

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

Sub DeleteFile(folderspec)
'----------DELETE DUMP FILE-------------------
'Could also Check how OLD files are!
  Const ForReading = 1, ForWriting = 2, ForAppending=8
  Dim fs,f,f1,fc,strFile,nSize
  Set fs = CreateObject("Scripting.FileSystemObject")
  TFile = 0
  'Lo script gira solo se la folder esiste
  'wscript.echo "From " & folderspec
  If (fs.FolderExists(folderspec)) Then
      Set f = fs.GetFolder(folderspec)
      Set fc = f.Files
      'Before enumerate files, check if its Temp folder or Perlogs, if so delete all older then X days recursive 
      For Each f1 in fc
          strFile=f1.name
          If (UCase(right(strFILE,4))=UCase(".dmp") ) Then
              TFile=TFile + 1 
              nSize=f1.size
              f1.delete
              WScript.Echo "Deleted file : " & strFile & " of "& toMegaBytes(nSize) & "MB" 
              ofile3.writeline computer & " , " & strFile & " , " & toMegaBytes(nSize) 
          End If                    
      Next
  End If
'Print counters and do additions for each folder    
TTFile = TTFile + TFile 
'Clean up
free = 0
  
End Sub

Sub DeleteOldFile(sRoot, iDaysOld)
'Deletes old files (x days)  from folder and subfolders 
'Should also timeout after X time
On error resume next
 Dim oFSO, oFolder, oFileCollection, oFile
 Dim oFolderCollection, oSubFolder, intFileSize, strFileName
 Set oFSO = CreateObject("Scripting.FileSystemObject")
 Set oFolder = oFSO.GetFolder(sRoot)
 TFile = 0
 
If (fs.FolderExists(sRoot)) Then
 Set oFileCollection = oFolder.Files        'gets all files of current folder
 Set oFolderCollection = oFolder.SubFolders
 'Walk through each file in this folder collection.
 For each oFile in oFileCollection 'If it is older than iDaysOld days, then delete it.
   
     If NOT oFile.name = "index.dat" then
        TFile=TFile + 1 
        ofile3.writeline sRoot & "\" & oFile.Name & " , " & oFile.Size & " , "  & oFile.DateLastModified 
        Wscript.StdOut.Write(".")
        oFile.Delete (True)
      End If
 End If
 Next
 For each oSubFolder in oFolderCollection   'Do a recursive call to delete files in sub-folders that are iDaysOld
    DeleteOldFile oSubFolder.Path, iDaysOld 'recalls function
 Next
end if ' folder dosent exist
'Counters
 TTFile2 = TTFile2 + TFile 'total files deleted by function
  'Clean up
 Set oFSO = Nothing
 Set oFolder = Nothing
 Set oFileCollection = Nothing
 Set oFile = Nothing
 set oFolderCollection = Nothing
 set oSubFolder = Nothing
End Sub

Function DeleteProfile(strProfile)
'Deletes Profiles older then 1 year, uses MS delprof tool
'Should have a timeout, sometimes it hangs
  dim strCmd
  dim objShell : Set objShell = WScript.CreateObject("WScript.Shell")
  
  strCmd = "cmd /c " & strScriptPath
  strCmd = strCmd & "delprof /Q /I /D:"
  strCmd = strCmd & intProfileDays & " /C:\\"
  strCmd = strCmd & strProfile
  'wscript.echo strCmd
  Dim objExecObject : Set objExecObject = objShell.Exec(strCmd)
  Dim nCnt    : nCnt  = 0
'Waits untill process is finished...  or times out and kills it
  Do While objExecObject.Status <> 1
      nCnt = nCnt + 1
      wscript.sleep 1000
      Wscript.StdOut.Write(".")
      if nCnt >= intTimeOut then
        call killprocess("delprof.exe",strProfile)
        exit do 'otherwise keeps calling killprocess
      end if        
  Loop

end function

Function killprocess(strProcessP,StrComputerP)
'Kills a Process, from remote computer, used after timeout happens
on error resume next 'in case process is finished before we kill
  Dim colProcess, objWMIService,objProcess
  strProcessP = "'" & strProcessP & "'" 'Formats for the query
  'wscript.echo "Killing process: " & strProcessP & " from: " & StrComputerP
  Set objWMIService = GetObject("winmgmts:" _
      & "{impersonationLevel=impersonate}!\\" _
      & strComputerP & "\root\cimv2")
  Set colProcess = objWMIService.ExecQuery _
  ("Select * from Win32_Process where name = " & strProcessP )
'If process not found goes into infinite loop, fixed(?)
  For Each objProcess in colProcess
      objProcess.Terminate()
      WSCript.Echo "Timeout (" & intTimeout & " secs.) Aborted Process: " & strProcessP & " on: " & strComputerP
      oFile.writeline "Timeout (" & intTimeout & " secs.) Aborted Process: " & strProcessP & " on: " & strComputerP
      exit for
  Next

end function

Function CheckFolder(objFolder,strComp) 
'Checks If any Profile is larger then X
'TODO: Could also check Last Login, check NTUser.dat LastModified 
  Dim oFSO        'FileSystemObject
  Dim oFolder        'Handle to the folder
  Dim oSubFolders    'Handle to subfolders collection
  Dim oSubFolder    'Handle to current subfolder in collection
'Connect to folder object and files
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oFolder = oFSO.GetFolder(objFolder)
  Set oSubFolders = oFolder.SubFolders
'Checks if Folder exists
  If oFSO.FolderExists(objFolder) = False Then
      Exit function
  End If    
  
 For Each oSubFolder In oSubFolders
         If oSubFolder.Size > intMaxProfile then 'If Profile Folder is bigger then 900mb
          ofile2.writeline strComp & " Large Profile(" & toMegabytes(oSubFolder.Size) & " MB) at: " & oSubFolder.Path
          Wscript.Echo "##WARNING: " & strComp & " Large Profile(" & toMegabytes(oSubFolder.Size) & " MB) at: " & VbCrLf & oSubFolder.Path
      end if
 Next
 
End Function

Function GetStatus(strComputer)
'Check if computer is UP
On Error Resume Next
      Dim wmiQuery, objWMIService, objPing, objStatus, intReply, i
      intReply = 0
      ' Define WMI query to ping
      wmiQuery = "Select * From Win32_PingStatus Where " & _
          "Address = '" & strComputer & "'"
      ' Make WMI connection to local machine
      Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
      ' Execute Query
      For i = 1 To 4
          Set objPing = objWMIService.ExecQuery(wmiQuery)
          ' Retrieve the status code of each ping request
          For Each objStatus In objPing
              Select Case objStatus.StatusCode
                  Case 0 
                      intReply = intReply + 1
              End Select
          Next
      Next
      Set objPing = Nothing
      Set objWMIService = Nothing
      ' Determine the image color depending on the number of pings successfully received
      Select Case True
          Case (intReply = 0)
              wscript.echo strComputer & " is down "
              strPingit = false
          Case (intReply => 3)
              strPingit = true
              'wscript.echo strComputer & " is up " & intReply
          Case Else
              strPingit = true
              'wscript.echo strComputer & " is up " & intReply
      End Select
End Function

Condo here, Just the functios....

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

end function

BTW: Forget IE, use Firefox

< Message edited by 4scriptmoni -- 8/21/2007 3:37:17 AM >

_____________________________

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

Revisions: 2 | Post #: 1

RE: Clean Servers -ISSUE with FORUM? - 8/21/2007 2:54:11 AM

CondoPC

Posts: 118
Score: 0
Joined: 7/23/2007
Status: offline

I am not sure why, but I have the hardest time being able to others' code in the code boxes. Most times I find either the thread is ended abruptlly with missing footer, or, in the case of this post, I cannot get all of the code. My page stops in the middle of the dumpFile function.

It could just be an IE 7 thing, but I know it's not a PC thing because I have hit this forum from multiple computers from different networks.

4scriptmoni - could you repost the code from dumpFile on?

(in reply to 4scriptmoni)