Solved

How to modify this script from Rob Sampson or PurplePomGranite?

Posted on 2008-10-27
8
349 Views
Last Modified: 2011-09-20
Hi Folks!

Attached you will find the script from Rob Sampson which deletes files from several folders both locally and remotely. Now I would want a few modifications.

1. Just run locally, on the computer it runs from
2. No msgboxes, no logging, all what can be deleted may survive ;)
3. And last clean this folder as well:


local settings\history


Also I ofund this script from PurplePomeGranite which deletes temporary internet files > works perfect, if that could be modified to include the above mentioned folders as well, that would be great too!

So either will do, just no logging msgboxes or remotely, thanks in advance!

Regarrds,

Peter

Rob Sampson
 
' Delete_Temp_Files_Remotely
Option Explicit
 
Dim objShell, objNetwork, objProcess, strUserName, strHostName, strCommand, strAdminUser, strAdminPass, strComputer
Dim objWMIService, colComputer, objComputer, boolClearCache, objFSO, strTempFiles
Dim strCacheLog, objInputFile, objFile, strFilePath, objSubFolder, objCacheLog, boolFound
Const intForReading = 1
 
If Left(WScript.ScriptFullName, 2) <> "\\" Then
	MsgBox "Please run this script from a UNC path."
	WScript.Quit
End If
 
Set objShell = CreateObject("Wscript.Shell")
Set objProcess = objShell.Environment("Process")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
strUserName = objProcess("USERNAME")
strHostName = objProcess("COMPUTERNAME")
 
If WScript.Arguments.Count < 1 Then
	Call Normal_User_Commands
ElseIf WScript.Arguments(0) = "AsAdmin" Then
	Call Admin_User_Commands
Else
	MsgBox "Unknown Argument received"
End If
 
Sub Normal_User_Commands
	' Enter your Administrative credentials here
	strAdminUser = InputBox("Enter user name:", "User name", "DEVELOPMENT\Administrator")
	strAdminPass = InputBox("Enter the password for " & strAdminUser & ":", "Password")
	
    'MsgBox "Running as initiating user"
    'strComputer = "."
    Set objInputFile = objFSO.OpenTextFile("Computers.txt", intForReading, False)
    While Not objInputFile.AtEndOfStream
	    '***********************  THIS MSGBOX CAN BE REMOVED FOR A LOGON SCRIPT *******************
	    ' If this MsgBox is used, the admin commands can be run on a remote machine.
	    'strComputer = InputBox("Enter computer to clear Temporary Internet Files on:", "Enter Computer", "172.16.2.64")
	    '******************************************************************************************
		strComputer = objInputFile.ReadLine
		If Ping(strComputer) = False Then
			'MsgBox strComputer & " did not respond to ping. Cannot continue script."
			WriteToLog strComputer & " did not respond to ping. Cannot continue script."
		Else
		
			On Error Resume Next
			Set objWMIService = GetObject("winmgmts:" _
			    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
			If Err.Number = 0 Then
				Err.Clear
				On Error GoTo 0
			    ' This command assumes that PSExec.exe (available from Microsoft) is stored on the shared folder
			    ' below.  It runs PSExec as the Admin user, on a remote machine, or the current machine if it is a
			    ' logon script.  It re-runs this file again, this time passing the "AsAdmin" argument, so the script
			    ' knows it has been run under an Admin account, and can safely execute the Admin_User_Commands Sub.
			    ' NOTE: If the Admin is running this script from a mapped drive, the client must have the same drive mapped,
			    ' because of the use of WScript.ScriptFullName below.  It is best to run this script from a UNC path,
			    ' so the client machine can access the file via a UNC path and not rely on a mapped drive.
				WriteToLog " *** *** Starting Script against all users on " & strComputer & ": " & Now
				strCommand = "cmd /c \\mccdc01\netlogon\psexec_194.exe -accepteula -i -e -u " & strAdminUser & " -p " & strAdminPass & " \\" & strComputer & " WScript """ & WScript.ScriptFullName & """ AsAdmin"
				objShell.Run strCommand, 1, True
			    ' NOTE: In the above two lines, you can change the cmd /c to cmd /k and the strCommand, 0, True to strCommand, 1, True
			    ' if you wish to see some output for debugging / testing purposes.
			    MsgBox "Finished running on " & strComputer
			Else
				Err.Clear
				On Error GoTo 0
				MsgBox "Error connecting to " & strComputer
				WriteToLog "Error connecting to " & strComputer
			End If
		End If
	Wend
 
End Sub
 
Sub Admin_User_Commands
	' Now the script has detected that "AsAdmin" was passed to it, and will run these commands.
	' Now running as Administrator on the target macchine
	' MsgBox "Running as Admin"
 
	For Each objSubFolder In objFSO.GetFolder(objShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%") & "\Documents and Settings\").SubFolders
		boolFound = False
		strTempFiles = objSubFolder.Path & "\Local Settings\Temporary Internet Files"
		If objFSO.FolderExists(strTempFiles) = False Then
			'MsgBox "Could not find " & strTempFiles
			WriteToLog "Could not find " & strTempFiles
			'WScript.Quit
		Else
			boolFound = True
		End If
		
		If boolFound = True Then DeleteFilesAtPath strTempFiles
	Next
 
	For Each objSubFolder In objFSO.GetFolder(objShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%") & "\Documents and Settings\").SubFolders
		boolFound = False
		strTempFiles = objSubFolder.Path & "\Local Settings\Temp"
		If objFSO.FolderExists(strTempFiles) = False Then
			'MsgBox "Could not find " & strTempFiles
			WriteToLog "Could not find " & strTempFiles
			'WScript.Quit
		Else
			boolFound = True
		End If
		
		If boolFound = True Then DeleteFilesAtPath strTempFiles
	Next
 
	boolFound = False
	strTempFiles = objShell.ExpandEnvironmentStrings("%WINDIR%") & "\Temp"
	If objFSO.FolderExists(strTempFiles) = False Then
		'MsgBox "Could not find " & strTempFiles
		WriteToLog "Could not find " & strTempFiles
		'WScript.Quit
	Else
		boolFound = True
	End If
	
	If boolFound = True Then DeleteFilesAtPath strTempFiles
 
End Sub
'======== END OF CLEAR TEMPORARY INTERNET FILES CACHE BLOCK ===========
 
Sub DeleteFilesAtPath(strThePath)
	strTempFiles = objFSO.GetFolder(strThePath).ShortPath
 
'======== METHOD 1 ===================
	strCacheLog = "Cache Files Cleared on " & objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") & ": " & Now & VbCrLf & "========================================"
	For Each objFile In objFSO.GetFolder(strTempFiles).Files
		strFilePath = objFile.Path
		On Error Resume Next
		objFSO.DeleteFile strFilePath, True
		If Err.Number = 0 Then
			strCacheLog = strCacheLog & VbCrLf & "SUCCESS: " & strFilePath
		Else
			Err.Clear
			strCacheLog = strCacheLog & VbCrLf & "FAILURE: " & strFilePath
		End If
		On Error GoTo 0
	Next	
	For Each objSubFolder In objFSO.GetFolder(strTempFiles).SubFolders
		Call RecurseSubFolders(objSubFolder)
	Next
	WriteToLog strCacheLog
'======== METHOD 2 ==================
	On Error Resume Next
	objFSO.DeleteFile(strTempFiles & "\*.*")
	Err.Clear
	On Error GoTo 0
	WriteToLog "Files deleted from " & strTempFiles
	
	RemoveEmptyFolders strTempFiles
End Sub
 
Sub RemoveEmptyFolders(strFolder)
	strCommand = "cmd /c dir " & strFolder & " /ad/b/s | sort /r > C:\EMPTYFOLDERS.TXT"
	objShell.Run strCommand, 0, True
	strCommand = "cmd /c for /f ""tokens=*"" %i in (C:\EMPTYFOLDERS.TXT) do rd /q %i"
	objShell.Run strCommand, 0, True
	objFSO.DeleteFile "C:\EMPTYFOLDERS.TXT", True
	WriteToLog "Empty folders removed from from " & strFolder
End Sub
 
Sub RecurseSubFolders(objFolder)
	For Each objFile In objFolder.Files
		On Error Resume Next
		strFilePath = objFile.Path
		objFSO.DeleteFile strFilePath, True
		If Err.Number = 0 Then
			strCacheLog = strCacheLog & VbCrLf & "SUCCESS: " & strFilePath
		Else
			Err.Clear
			strCacheLog = strCacheLog & VbCrLf & "FAILURE: " & strFilePath
		End If
		On Error GoTo 0
	Next
 
	For Each objSubFolder In objFolder.SubFolders
		Call RecurseSubFolders(objSubFolder)
	Next
End Sub
'=======================
 
Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function
 
Sub WriteToLog(strText)
	Set objCacheLog = objFSO.OpenTextFile(Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "ClearCacheLog.txt", 8, True)
	objCacheLog.Write VbCrLf & VbCrLf & strText
	objCacheLog.Close
	Set objCacheLog = Nothing
End Sub
 
 
 
 
PurpleMomeGranite
 
Const TEMPORARY_INTERNET_FILES = &H20&
dim intDepth
 
Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objShell.Namespace(TEMPORARY_INTERNET_FILES)
Set objFolderItem = objFolder.Self
intDepth=0
RemoveFolder objFolderItem
 
sub RemoveFolder(objFolder)
        ' Recursively remove files and folders
        intDepth=intDepth+1
        on error resume next
        for each objFile in objFolder.Files
                objFile.Delete true
        next
        Err.Clear
        on error goto 0
        for each objSubfolder in objFolder.SubFolders
                RemoveFolder objSubFolder
        next
        intDepth=intDepth-1
        if intDepth<>0 then' Don't delete top-level folder
                on error resume next
                objFolder.Delete true 
                err.Clear
                on error goto 0
        end if
end sub

Open in new window

0
Comment
Question by:PeterdeB
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 4
8 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 22827315
Hi there....my code deletes files from multiple profiles, whereas Purple's only does the current user.  Deleting the current user's files requires no additional permissions, but deleting from multiple profiles will require admin rights.

So, do you need this from the current profile only, on the current computer?  Also, my code deletes
Local Settings\Temporary Internet Files
Local Settings\Temp
%windir%\Temp

Do you still want all of those to be emptied?

Regards,

Rob.
0
 

Author Comment

by:PeterdeB
ID: 22829489
Hi Rob, only the current user will do and yes they all should be emptied and the history folder in addition.

Regards,

Peter
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 22838405
Hi, try this out.  I haven't tested it yet, but it's now for the current user profile only, and has no logging.

It deletes files from these folders:
%USERPROFILE%\Local Settings\Temporary Internet Files
%USERPROFILE%\Local Settings\Temp
%USERPROFILE%\Local Settings\History
%WINDIR%\Temp

Regards,

Rob.
Set objShell = CreateObject("Wscript.Shell")
Set objProcess = objShell.Environment("Process")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
strTempFiles = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Local Settings\Temporary Internet Files"
If objFSO.FolderExists(strTempFiles) = True Then DeleteFilesAtPath strTempFiles
 
strTempFiles = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Local Settings\Temp"
If objFSO.FolderExists(strTempFiles) = True Then DeleteFilesAtPath strTempFiles
 
strTempFiles = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Local Settings\History"
If objFSO.FolderExists(strTempFiles) = True Then DeleteFilesAtPath strTempFiles
 
strTempFiles = objShell.ExpandEnvironmentStrings("%WINDIR%") & "\Temp"
If objFSO.FolderExists(strTempFiles) = True Then DeleteFilesAtPath strTempFiles
 
Sub DeleteFilesAtPath(strThePath)
	strTempFiles = objFSO.GetFolder(strThePath).ShortPath
 
'======== METHOD 1 ===================
	For Each objFile In objFSO.GetFolder(strTempFiles).Files
		strFilePath = objFile.Path
		On Error Resume Next
		objFSO.DeleteFile strFilePath, True
		On Error GoTo 0
	Next	
	For Each objSubFolder In objFSO.GetFolder(strTempFiles).SubFolders
		Call RecurseSubFolders(objSubFolder)
	Next
	WriteToLog strCacheLog
'======== METHOD 2 ==================
	On Error Resume Next
	objFSO.DeleteFile(strTempFiles & "\*.*")
	Err.Clear
	On Error GoTo 0
	
	RemoveEmptyFolders strTempFiles
End Sub
 
Sub RemoveEmptyFolders(strFolder)
	strCommand = "cmd /c dir " & strFolder & " /ad/b/s | sort /r > C:\EMPTYFOLDERS.TXT"
	objShell.Run strCommand, 0, True
	strCommand = "cmd /c for /f ""tokens=*"" %i in (C:\EMPTYFOLDERS.TXT) do rd /q %i"
	objShell.Run strCommand, 0, True
	objFSO.DeleteFile "C:\EMPTYFOLDERS.TXT", True
End Sub
 
Sub RecurseSubFolders(objFolder)
	For Each objFile In objFolder.Files
		On Error Resume Next
		strFilePath = objFile.Path
		objFSO.DeleteFile strFilePath, True
		On Error GoTo 0
	Next
 
	For Each objSubFolder In objFolder.SubFolders
		Call RecurseSubFolders(objSubFolder)
	Next
End Sub

Open in new window

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:PeterdeB
ID: 22839316
Hi Rob,

Only had to comment out the writelog thingie (30,2) but after that it worked like a charm thanks alot!

Regards,

Peter

Ps does it use the emptyfolders.txt to determine which folders it has to delete?
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22845023
Oh yeah, missed that WriteToLog line....sorry....

>> does it use the emptyfolders.txt to determine which folders it has to delete?

Not exactly.  That bit's actually a bit deceptive.  What happens is this command
cmd /c dir " & strFolder & " /ad/b/s | sort /r

actually outputs all of the directories in a folder path, and just goes through each one in turn, executing the RD command.  The trick behind that is that is that the RD command fails to remove non-empty folders.  Therefore, as it goes through each folder, only empty folders will be removed.

Regards,

Rob.
0
 

Author Comment

by:PeterdeB
ID: 22850766
Ah okay I see, for instance the folder that holds the index.dat file. Thanks for the script!

Peter
0
 

Author Closing Comment

by:PeterdeB
ID: 31510273
Thank you!
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22854538
Exactly. That file is always in use while the user is logged on, so the folder cannot be deleted.

Regards,

Rob.
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Welcome, welcome!  If you are new to the series and haven't been following along, please take a brief moment to review the first three installments: Part 1 (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/A_266-VBScri…
Well hello again!  Glad to see you've made it this far without giving up.  In this, the fourth installment of my popular series, I'm going to cover functions and subroutines, what they are, and why they are useful.  Just in case you stumbled onto th…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…
Suggested Courses

734 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question