use Getopt::Long;
#use diagnostics;
#use strict;
use Win32::Console;
use File::Find;
use Cwd;
use Win32::API::Prototype;

##################
# main procedure #
##################
my (%config);
my ($files,$dirs);
my ($totalsize) = 0;

p_parsecmdline(%config, @ARGV);
p_checkargs();

# set console codepage
Win32::Console::OutputCP(1252);

# check drive is valid
my $drive = $config{drive};
$drive =~ s/W+//;
$drive .= “:\”;
if (! -d $drive) {
die “ERROR: $drive is not a valid drive”;
}
# compute log file name if it hasn’t been specified
unless (defined ($config{log})) {
my $time = time();
$time = localtime($time);
my @time = split(/s+/,$time);
$config{log} = “cleandrive-$time[4]$time[1]$time[2].log”;
}
unless ($config{log} =~ /\/) {
my $cwd = getcwd;
unless ($cwd =~ //$/) {
$cwd .= “/”;
}
$config{log} = “$cwd$config{log}”;
}
# delete temp dirs content and dump files
p_cleantemp($config{drive});
p_cleandumps($config{drive});
# apply ntfs compression
if (defined ($config{compress})) {
p_compressfolders($config{drive},$config{compress});
}
# process files to delete
if (defined ($config{filelist})) {
p_delfiles($config{drive},$config{filelist});
}
# print summary of what was done
if (defined ($files) and defined ($dirs)) {
if (defined ($config{test})) {
print “n$files files and $dirs directories would have been deleted.n”;
} else {
print “n$files files and $dirs directories were deleted.n”;
}

my $TotalSizeUnit = “bytes”;
my $count = 0;
while ($totalsize > 1024) {
$totalsize = $totalsize / 1024;
++$count;
}
if ($count == 1) {
$TotalSizeUnit = “KB”;
} elsif ($count == 2) {
$TotalSizeUnit = “MB”;
} elsif ($count == 3) {
$TotalSizeUnit = “GB”;
} elsif ($count == 4) {
$TotalSizeUnit = “TB”;
} elsif ($count == 5) {
$TotalSizeUnit = “PB”;
}

print “Total space saved: “;
printf (“%.2f”,$totalsize);
print ” $TotalSizeUnit.n”;
my $logpath = $config{log};
$logpath =~ s///\/g;
print “Log file is $logpathn”;
} else {
print “nThere were no files or directories to process.n”;
}

my $LocalHost = Win32::NodeName();
p_getfreespace($LocalHost,$config{drive});

exit (0);

##################
# sub-procedures #
##################

# procedure p_help
# displays a help message
sub p_help {
my ($script)=($0=~/([^\/]*?)$/);
my ($header)=$script.” v1.3.1 – Author: alin.dumenica@gmail.com”;
my ($line)=”-” x length($header);
print < <EOT;

$header
$line
Used to clean a logical drive. This script deletes temporary files,
kernel and user memory dumps as well as internet temporary files.
Optionally, it can also compress log directories and/or delete a
list of specified files and/or directories.

Usage: $script /[d]rive /[l]og
/[c]ompress /[f]ilelist
/[t]est /[v]erbose /[h]elp

/drive Logical drive letter to clean.
/log Name of logfile (default is cleandrive-YYYYmonthDD.log).
/compress Use NTFS compression on specified path (e.g. c:\temp).
A file containing a list of paths can also be specified.
File contains one entry per line.
/filelist Name of a file containing a list of files or
directories to delete (example of entry in file is
c:\temp; file contains one entry per line; wildcard
* can be used to specify that line applies to all drives).
/test Do not delete any files, but only log what would
be done.
/verbose Shows what is being done as it is being done.
/help Shows this help message.
EOT

exit 1;
}
# procedure p_parsecmdline
# parses the command line and retrieves arguments values
sub p_parsecmdline {
my ($config) = @_;
Getopt::Long::Configure(“prefix_pattern=(-|/)”);
GetOptions($config, qw(
drive|d=s
log|l=s
compress|c=s
filelist|f=s
test|t
verbose|v
help|?|h));
}
# procedure p_checkargs
# checks the arguments which have been used are a valid combination
sub p_checkargs {
if ($config{help}) {
p_help();
}
unless (defined ($config{drive})) {
p_help();
}
}
# procedure p_cleantemp
# deletes content of temporary directories
sub p_cleantemp {
my $drive = shift;
# strip drive letter of all non alpha-numeric characters
$drive =~ s/W+//;
my @temp;

# populate array @temp of temporary directories on $drive
if ((-d “$drive:/temp”) and (“$drive:\temp” ne lc($ENV{TEMP})) and (“$drive:\temp” ne lc($ENV{TMP}))) {
push (@temp,”$drive:/temp”);
}
if ((-d “$drive:/tmp”) and (“$drive:\tmp” ne lc($ENV{TEMP})) and (“$drive:\tmp” ne lc($ENV{TMP}))) {
push (@temp,”$drive:/tmp”);
}
# add environment variables that define temporary directories,
# only if they are located on $drive
if ($ENV{TEMP} =~ /^$drive/i) {
my $temp = $ENV{TEMP};
$temp =~ s/\///g;
push (@temp,$temp);
}
if (($ENV{TMP} =~ /^$drive/i) and (lc($ENV{TMP}) ne lc($ENV{TEMP}))) {
my $tmp = $ENV{TMP};
$tmp =~ s/\///g;
push (@temp,$tmp);
}

foreach my $dir (@temp) {
my $FormattedDir = $dir;
$FormattedDir =~ s///\/g;
print “n Processing ‘$FormattedDir’ directory” if defined ($config{verbose});
finddepth (&p_del, “$dir”);
}

# determine if $drive is the system drive, in which case process user profiles temp directories
if (lc($ENV{SYSTEMDRIVE}) eq lc(“$drive:”)) {
my @profiles = (“$ENV{SYSTEMROOT}\Profiles”,”$drive:\Documents and Settings”);
foreach my $dir (@profiles) {
if (-d $dir) {
opendir (PROFILES, $dir) or next;
while (my $folder = readdir(PROFILES)) {
if (($folder eq “.”) or ($folder eq “..”)) {
next;
}
my $path = “$dir\$folder”;
if (-d “$path\Local Settings\temp”) {
print “n Processing ‘$path\Local Settings\temp’ directory” if defined ($config{verbose});
finddepth (&p_del, “$path\Local Settings\temp”);
}
if (-d “$path\Local Settings\Temporary Internet Files”) {
print “n Processing ‘$path\Local Settings\Temporary Internet Files’ directory” if defined ($config{verbose});
finddepth (&p_del, “$path\Local Settings\Temporary Internet Files”);
}
}
closedir (PROFILES);
}
}
# process SYSTEMROOTtemp if it exists
if (-d “$ENV{SYSTEMROOT}\temp”) {
my $path = “$ENV{SYSTEMROOT}\temp”;
print “n Processing ‘$path’ directory” if defined ($config{verbose});
finddepth (&p_del, “$path”);
}
}
}
# procedure p_cleandumps
# deletes kernel and user memory dumps
sub p_cleandumps {
my $drive = shift;
$drive =~ s/W+//;
# search logical drive for memory.dmp and user.dmp files and delete them
if (lc($ENV{SYSTEMDRIVE}) eq lc(“$drive:”)) {
# test for memory.dmp and delete it if it is 5 days or older only
if (-f “$ENV{SYSTEMROOT}\memory.dmp”) {
open (FILE, “$ENV{SYSTEMROOT}\memory.dmp”);
my @filestat = stat(FILE);
my $time = time();
my $seconds = $time – $filestat[9];
if ($seconds > 432000) {
print “n Processing $ENV{SYSTEMROOT}\memory.dmp” if defined ($config{verbose});
if (defined ($config{test})) {
p_log($config{log},”File $ENV{SYSTEMROOT}\memory.dmp would have been deleted.n”);
++$files;
$totalsize += $filestat[7];
} elsif (unlink (“$ENV{SYSTEMROOT}\memory.dmp”)) {
p_log($config{log},”File $ENV{SYSTEMROOT}\memory.dmp was deleted.n”);
++$files;
$totalsize += $filestat[7];
}
}
close (FILE);
}
if (-d “$ENV{SYSTEMROOT}\Minidump”) {
print “n Processing the ‘$ENV{SYSTEMROOT}\Minidump’ directory” if defined ($config{verbose});
opendir (MINIDUMP, “$ENV{SYSTEMROOT}\Minidump”);
while (my $file = readdir(MINIDUMP)) {
# delete mini dumps that are older than 5 days
next if (($file eq “.”) or ($file eq “..”));
my $path = “$ENV{SYSTEMROOT}\Minidump”;
if (-f “$path\$file”) {
my @filestat = stat(FILE);
my $time = time();
my $seconds = $time – $filestat[9];
if ($seconds > 432000) {
if (defined ($config{test})) {
p_log($config{log},”File $path\$file would have been deleted.n”);
++$files;
$totalsize += $filestat[7];
} elsif (unlink (“$path\$file”)) {
p_log($config{log},”File $path\$file was deleted.n”);
++$files;
$totalsize += $filestat[7];
}
}
}
}
closedir (MINIDUMP);
}
}
}
# procedure p_compressfolders
# applies NTFS compression to path(s)
sub p_compressfolders {
my ($drive,$folders) = @_;
my (@folderlist);
$drive =~ s/W+//;
# determine if a filename has been specified, if so, then call sub p_readfile
if (-f $folders) {
@folderlist = p_readfile($folders);
} else {
@folderlist = $folders;
}
print “n Applying NTFS compression” if defined ($config{verbose});
# for each entry in the array, apply NTFS compression after making sure the path is valid
# and that the path is on the drive being cleaned
foreach my $file (@folderlist) {
$file =~ s/^*:/$drive:/i;
if ((-d “$file”) and ($file =~ /^$drive:/i)) {
print “.” if defined ($config{verbose});
if (defined ($config{test})) {
p_log($config{log},”Would have attempted to NTFS compress $filen”);
} else {
`compact /C /S /I $file`;
p_log($config{log},”Attempted to NTFS compress $filen”);
}
}
}
}
# procedure p_readfile
# reads the content of a file into an array
sub p_readfile {
my $file = shift;
my (@list);
# open handle to the file
open (FILE,$file);
my $i = 0;
while (defined (my $entry = )) {
chomp ($entry);
$list[$i] = $entry;
++$i;
}
return (@list);
}
# procedure p_delfiles
# delete specified files
sub p_delfiles {
my ($drive,$files) = @_;
my (@filelist);
$drive =~ s/W+//;
# call sub p_readfile
if (-f $files) {
@filelist = p_readfile($files);
print “n Processing entries in ‘$files’” if defined ($config{verbose});
# for each element in the array, delete the file or directory
foreach my $file (@filelist) {
$file =~ s/^*:/$drive:/i;
if ((-d $file) and ($file =~ /^$drive:/i)) {
finddepth (&p_del, “$file”);
} elsif ((-f $file) and ($file =~ /^$drive:/i)) {
print “.” if defined ($config{verbose});
open (FILE,”$file”);
my @filestat = stat(FILE);
close (FILE);
if (defined ($config{test})) {
p_log($config{log},”File $file would have been deleted.n”);
++$files;
$totalsize += $filestat[7];
} elsif (unlink($file)) {
p_log($config{log},”File $file was deleted.n”);
++$files;
$totalsize += $filestat[7];
}
}
}
}
}
# procedure p_del
# used by File::Find call to delete files or directories
sub p_del {
if (-d $File::Find::name) {
if (defined ($config{test})) {
p_log($config{log},”Directory $File::Find::name would have been removed.n”);
++$dirs;
} elsif (rmdir(“$File::Find::name”)) {
p_log($config{log},”Directory $File::Find::name was removed.n”);
++$dirs;
}
print “.” if defined ($config{verbose});
} elsif (-f $File::Find::name) {
open (FILE,”$File::Find::name”);
my @filestat = stat(FILE);
close (FILE);
if (defined ($config{test})) {
p_log($config{log},”File $File::Find::name would have been deleted.n”);
++$files;
$totalsize += $filestat[7];
} elsif (unlink(“$File::Find::name”)) {
p_log($config{log},”File $File::Find::name was deleted.n”);
++$files;
$totalsize += $filestat[7];
}
print “.” if defined ($config{verbose});
}
}
# procedure p_log
# manages creating log entries
sub p_log {
my ($logfile,$message) = @_;
my $time = time();
$time = localtime($time);
open (LOG, “>>$logfile”) or die “nERROR: could not open $logfile: $^En”;
$message =~ s///\/g;
print LOG “$time: $message”;
close (LOG);
}
# procedure p_getfreespace
# returns the number of free bytes on a remote drive
sub p_getfreespace {
my ($servername,$drive) = @_;
my $Win32Error = 0;
my $pFree = pack(“L2″,0,0);
my $pTotal = pack(“L2″,0,0);
my $pTotalFree = pack(“L2″,0,0);
my $path = “\\”.$servername.”\”.$drive.”$\”;

# import Win32API function
ApiLink(‘kernel32.dll’,'BOOL GetDiskFreeSpaceEx(
LPCTSTR lpDirectoryName,
PVOID lpFreeBytesAvailable,
PVOID lpTotalNumberOfBytes,
PVOID lpTotalNumberOfFreeBytes)’)
or die “nERROR: cannot link to GetDiskFreeSpaceExn”;

# make the function call
if (GetDiskFreeSpaceEx($path,$pFree,$pTotal,$pTotalFree)) {
# compute the number of free bytes
my $freespace = p_MakeLargeInt(unpack(“L2″,$pTotalFree));
my $TotalSpace = p_MakeLargeInt(unpack(“L2″,$pTotal));
my $SpaceUsed = $TotalSpace – $freespace;
my $PercentageUsed = ($SpaceUsed * 100) / $TotalSpace;

my $FreeSpaceUnit = “bytes”;
my $i = 0;
while ($freespace > 1024) {
$freespace = $freespace / 1024;
++$i;
}
if ($i == 1) {
$FreeSpaceUnit = “KB”;
} elsif ($i == 2) {
$FreeSpaceUnit = “MB”;
} elsif ($i == 3) {
$FreeSpaceUnit = “GB”;
} elsif ($i == 4) {
$FreeSpaceUnit = “TB”;
} elsif ($i == 5) {
$FreeSpaceUnit = “PB”;
}

my $TotalSpaceUnit = “bytes”;
$i = 0;
while ($TotalSpace > 1024) {
$TotalSpace = $TotalSpace / 1024;
++$i;
}
if ($i == 1) {
$TotalSpaceUnit = “KB”;
} elsif ($i == 2) {
$TotalSpaceUnit = “MB”;
} elsif ($i == 3) {
$TotalSpaceUnit = “GB”;
} elsif ($i == 4) {
$TotalSpaceUnit = “TB”;
} elsif ($i == 5) {
$TotalSpaceUnit = “PB”;
}

$freespace = p_FormatNumber($freespace);
$TotalSpace = p_FormatNumber($TotalSpace);
print “There now is “;
printf “%.2f”,$freespace;
print ” $FreeSpaceUnit available out of “;
printf “%.2f”,$TotalSpace;
print ” $TotalSpaceUnit (“;
printf “%.2f”,$PercentageUsed;
print “% used) on the $drive: drive.n”;
} else {
$Win32Error = Win32::GetLastError();
my $ErrorMessage = Win32::FormatMessage($Win32Error);
print “\\$servername\$drive$ ERROR $Win32Error: $ErrorMessage”;
}

exit $Win32Error;
}
# procedure p_MakeLargeInt
# convert number into a decimal number
sub p_MakeLargeInt {
my($Low,$High) = @_;
return($High*(1+0xFFFFFFFF)+$Low);
}
# procedure p_FormatNumber
# add comas in number to make it more readable
sub p_FormatNumber {
my($Num) = @_;
{} while ($Num =~ s/^(-?d+)(d{3})/$1,$2/);
return($Num);
}