'==========================================================================
'
'
' AUTHOR: Konstantin Timokhin [k.timokhin@gmail.com]
' DATE  : 14.05.2006
'
' COMMENT: clear common exchange folders
'
'==========================================================================
On Error Resume Next 
'================================
'preinitialization
'================================
Set args = WScript.Arguments

if args.Count = 0 Then
   WScript.Echo "Usage: [CScript | WScript] clear_exchange.vbs <exchangefolderspoint>"
   WScript.Quit 1
end if
'================================
'defining global values
'================================

ExchangeFoldersPoint = args.Item(0) 'main point of exchange folders
DeletionQueueFolderName = "_deletion_queue_"   'folder inside each exchange folders like stored "deleted file"
LeaveOutFolders = Array("")                    'do not disturb folders
SkipedFiles = Array("exchange_folder_information.txt")              'touch-me-not files inside exchange folders
SkipedFolders = Array(DeletionQueueFolderName, "donotdelete") 'touch-me-not folders inside exchange folders 
											   'DeletionQueueFolderName must be permanently included in this list
DeletionQueueDaysOld = 10 'days past since last file modification sufficiently for deleting
ExchangeDaysOld = 7       'days past since last file modification sufficiently for moving to deletion queue

'================================
' functions library
'================================

'----common functions-----

Function InArray(Arr, SearchIt)
  arr_temp = Filter(Arr, SearchIT, True, 1)
  InArray = false
  For Each element In arr_temp
  	If UCase(element) = UCase(SearchIt) Then InArray = true
  Next
End Function

Function FixAp(body)
	FixAp=Replace(body, "'", "\'")
End Function

'----files and folders operations----

Function DeleteFolder(Folderpath)
    DeleteFolder = 53
	Set colFolders = objWMIService.ExecQuery("Select * from Win32_Directory where Name = '" & FixAp(Replace(Folderpath, "\", "\\")) & "'")
	For Each objFolder in colFolders
    	errResults = objFolder.Delete
	Next
	DeleteFolder = errResult
    'objFSO.DeleteFolder(Folderpath)
End Function

Function MoveFolder(SourcePath, DestinationPath, Foldername)
    MoveFolder = 53
	Set colFolders = objWMIService.ExecQuery("Select * from Win32_Directory where Name = '" & FixAp(Replace(SourcePath & "\" & Foldername, "\", "\\")) &"'")
	For Each objFolder in colFolders
    	errResults = objFolder.Rename(DestinationPath & "\" & Foldername)
	Next
	MoveFolder = errResults
End Function

Function DeleteFile(Filepath)
    DeleteFile = 53
	Set colFiles = objWMIService.ExecQuery("Select * from CIM_Datafile where Name = '" & FixAp(Replace(Filepath, "\", "\\")) & "'")
	For Each objFile in colFiles
		errResults = objFile.Delete
	Next
	DeleteFile = errResults
End Function

Function MoveFile(SourcePath, DestinationPath, Filename)
    MoveFile = 53
	Set colFiles = objWMIService.ExecQuery("Select * from CIM_Datafile where Name = '" & FixAp(Replace(SourcePath & "\" & Filename, "\", "\\")) & "'")
	For Each objFile in colFiles
		errResults = objFile.Rename(DestinationPath & "\" & Filename)
	Next
	MoveFile = errResult
End Function

Function DeleteFolders(SourcePath, ExcludedDirs)
	Set objFolder = objFSO.GetFolder(SourcePath)
	Set colSubfolders = objFolder.Subfolders
	For Each objSubfolder in colSubfolders
	    If Not InArray(ExcludedDirs, objSubfolder.Name) Then DeleteFolder(SourcePath & "\" & objSubfolder.Name)
	Next
End Function

Function MoveFolders(SourcePath, DestinationPath, ExcludedDirs)
	Set objFolder = objFSO.GetFolder(SourcePath)
	Set colSubfolders = objFolder.Subfolders
	For Each objSubfolder in colSubfolders
		If Not InArray(ExcludedDirs, objSubfolder.Name) Then MoveFolder SourcePath, DestinationPath, objSubfolder.Name
	Next
End Function

Function DeleteFiles(SourcePath, ExcludedFiles)
  Set Folder = objFSO.GetFolder(SourcePath)
  For Each file In Folder.Files
    If Not InArray(ExcludedFiles, Mid(file, Len(SourcePath)+2)) Then DeleteFile(file)
  Next
End Function

Function MoveFiles(SourcePath, DestinationPath, ExcludedFiles)
  Set Folder = objFSO.GetFolder(SourcePath)
  For Each file In Folder.Files
    If Not InArray(ExcludedFiles, Mid(file, Len(SourcePath)+2)) Then MoveFile SourcePath, DestinationPath, Mid(file, Len(SourcePath)+2)
  Next
End Function

'================================
'initiallization
'================================

strComputer = "."
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

'================================
'processing
'================================

Function deleteOldFiles(Folderpath, DaysOld)
'first processing all subfolders
  deleteOldFiles = False
  For Each Subfolder In objFSO.GetFolder(Folderpath).SubFolders
     sPath = Subfolder.Path
     If Not deleteOldFiles(Subfolder.Path, DaysOld) Then
     	DeleteFolder sPath
     Else
     	deleteOldFiles = True
     End If	
  Next
'next proccessing old files
  For Each File In objFSO.GetFolder(Folderpath).Files
	 If File.DateLastModified < (Date() - DaysOld) Then
		If DeleteFile(File) Then deleteOldFiles = True
	 Else
	 	deleteOldFiles = True
	 End If
  Next  
End Function

filesIsMoved = 0

Function moveOldFiles(Folderpath, DaysOld, ExcludedFolders, ExcludedFiles)
'first processing all subfolders
  moveOldFiles = 1
  For Each Subfolder In objFSO.GetFolder(Folderpath).SubFolders
     sPath = Subfolder.Path
     If Not InArray(ExcludedFolders, Subfolder.Name) Then
        If moveOldFiles(Subfolder.Path, DaysOld, ExcludedFolders, ExcludedFiles) Then
     	  DeleteFolder sPath
     	Else
     	  moveOldFiles = 0
     	End If
     Else
     	moveOldFiles = 0
     End If	
  Next
'next proccessing old files
  structureCreated = False
  curFolder = Mid(FolderPath, Len(ExchangeFoldersPoint) + 2)
  curDFolder = ExchangeFoldersPoint + "\" + DeletionQueueFolderName + "\" + curFolder
  For Each File In objFSO.GetFolder(Folderpath).Files
	 If Not InArray(ExcludedFiles, Mid(file, Len(Folderpath)+2)) And File.DateLastModified < (Date() - DaysOld) Then
	 	If Not structureCreated Then
	 	    If Not objFSO.FolderExists(curDFolder) Then
	 	        tArr = Split(curFolder, "\")
	 	        cDir = ""
				For Each DirName In tArr
				  If cDir = "" Then 
				  	cDir = DirName
				  Else
				  	cDir = cDir & "\" & DirName
				  End If
				  tDir = ExchangeFoldersPoint + "\" + DeletionQueueFolderName + "\" & cDir
  	 	    	  If Not objFSO.FolderExists(tDir) Then objFSO.CreateFolder(tDir)
  	 	    	Next
	 	    End If
	 		structureCreated = 1
	 	End If
		MoveFile FolderPath, curDFolder, Mid(File, Len(FolderPath)+2)
	 Else
	 	moveOldFiles = 0
	 End If
  Next
End Function

Function ProcessExchangeFolder(Folderpath)
'checking existing deletion queue folder and creating it on necessary
 If not objFSO.FolderExists(Folderpath & "\" & DeletionQueueFolderName) Then
   objFSO.CreateFolder(Folderpath & "\" & DeletionQueueFolderName)
 Else
 	deleteOldFiles Folderpath & "\" & DeletionQueueFolderName, DeletionQueueDaysOld
 End If
 moveOldFiles Folderpath, ExchangeDaysOld, SkipedFolders, SkipedFiles
End Function

'For Each Subfolder in objFSO.GetFolder(ExchangeFoldersPoint).SubFolders
'   If not InArray(LeaveOutFolders, Subfolder.Name) Then 
'     currentExchangeFolder = Subfolder.Name
'   	 ProcessExchangeFolder(Subfolder.Path)
'   End If
'Next

ProcessExchangeFolder(ExchangeFoldersPoint)