WEB LISTING 1: CleanCache.pl

##########################################################################
#
# CleanCache.pl
# -------------
# This script deletes everything from the Windows Internet cache, including
# cached groups, cached files, cookies, visited URL list, temp files,
# temp Internet files, history list, and the recent file list.
#
# This script requires the Win32::API and Win32::API::Prototype extensions,
# which you can obtain from http://dada.perl.it/#api and
# http://www.roth.net/perl/packages, respectively.

use Win32::API::Prototype;
use Win32::Registry;
use Getopt::Long;
use strict;
use vars qw( %Config %Total $VERSION %REGISTRY_KEY %Time %CACHE_ENTRY
            $CACHEGROUP_SEARCH_ALL
            $CACHEGROUP_FLAG_FLUSHURL_ONDELETE
            $CACHEGROUP_ATTRIBUTE_GET_ALL
            $ERROR_NO_MORE_FILES
            $ERROR_NO_MORE_ITEMS
            $ERROR_INSUFFICIENT_BUFFER
            $GROUPNAME_MAX_LENGTH
            $GROUP_OWNER_STORAGE_SIZE
            $CACHE_GROUP_STRUCT
            $KILOBYTE
            $MEGABYTE
            $GIGABYTE
            $TERABYTE
            $SHERB_NOCONFIRMATION 
            $SHERB_NOPROGRESSUI   
            $SHERB_NOSOUND        
            $QUERY_RECYCLE_BIN_STRUCT
            $SHGFP_TYPE_CURRENT
            $CSIDL_RECENT         
            $CSIDL_INTERNET_CACHE 
            $CSIDL_HISTORY        
            $DELETED_FILE_RENAME_SUFFIX
            $SHERB_NOCONFIRMATION  
            $SHERB_NOPROGRESSUI    
            $SHERB_NOSOUND         
            $QUERY_RECYCLE_BIN_STRUCT
);

##########################################################################
#
# These constants are global, so no lexical scoping.
#
$VERSION = 20030806;

$CACHEGROUP_SEARCH_ALL = 0x00000000;
$CACHEGROUP_FLAG_FLUSHURL_ONDELETE = 0x00000002;
$CACHEGROUP_ATTRIBUTE_GET_ALL = 0xffffffff;
$ERROR_NO_MORE_FILES = 18;
$ERROR_NO_MORE_ITEMS = 259;
$ERROR_INSUFFICIENT_BUFFER = 122;
$GROUPNAME_MAX_LENGTH = 120;
$GROUP_OWNER_STORAGE_SIZE = 4;
$CACHE_GROUP_STRUCT = "L5L$GROUP_OWNER_STORAGE_SIZE" . 
"A$GROUPNAME_MAX_LENGTH";
$KILOBYTE = 1024;
$MEGABYTE = 1024 * $KILOBYTE;
$GIGABYTE = 1024 * $MEGABYTE;
$TERABYTE = 1024 * $GIGABYTE;
$SHERB_NOCONFIRMATION   = 0x00000001;
$SHERB_NOPROGRESSUI     = 0x00000002;
$SHERB_NOSOUND          = 0x00000004;
$QUERY_RECYCLE_BIN_STRUCT = "LL2L2";
$SHGFP_TYPE_CURRENT = 0;
$CSIDL_RECENT           = 0x0008;
$CSIDL_INTERNET_CACHE   = 0x0020;
$CSIDL_HISTORY          = 0x0022;
$DELETED_FILE_RENAME_SUFFIX = ".OLD.DELETE.ME";
$SHERB_NOCONFIRMATION    = 0x00000001;
$SHERB_NOPROGRESSUI      = 0x00000002;
$SHERB_NOSOUND           = 0x00000004;
$QUERY_RECYCLE_BIN_STRUCT = "LL2L2";

%REGISTRY_KEY = (
  'typed_url_list'    =>  "Software\\Microsoft\\Internet Explorer
\\TypedURLs",
  'intelliforms_data' =>  "Software\\Microsoft\\Internet Explorer
\\IntelliForms\\SPW",
  'explorer_run_mru'  =>  "Software\\Microsoft\\Windows\\
CurrentVersion\\Explorer\\RunMRU",
);

%CACHE_ENTRY = (
  COOKIE => 0x00100000,
  NORMAL => 0x00000001,
  STICKY => 0x00000004,
  TRACK_OFFLINE => 0x00000010,
  TRACK_ONLINE => 0x00000020,
  URLHISTORY => 0x00200000,
  SPARSE => 0x00010000
);

%Time = ();
##########################################################################
#
# Set up the %Config global hash with default values and
# configure the %Config hash with user settings passed in.
#
%Config = (
  filter  =>  $CACHE_ENTRY{COOKIE}
            | $CACHE_ENTRY{STICKY}
            | $CACHE_ENTRY{URLHISTORY}
            | $CACHE_ENTRY{NORMAL},
);

Configure( \%Config );
if( $Config{help} )
{
  Syntax();
  exit;
}

##########################################################################
#
# Load binary libraries.
#
ApiLink( "wininet", "HANDLE FindFirstUrlCacheEntry(         
                        LPCTSTR lpszUrlSearchPattern,
                        PVOID lpFirstCacheEntryInfo,
                        LPDWORD lpdwFirstCacheEntryInfoBufferSize )" ) || die;
ApiLink( "wininet", "BOOL FindNextUrlCacheEntry(         
                        HANDLE hEnumHandle,
                        PVOID lpNextCacheEntryInfo,
                        LPWORD lpdwNextCacheEntryInfoBufferSize )" ) || die;
ApiLink( "wininet", "HANDLE FindFirstUrlCacheGroup(         
                    DWORD dwFlags,
                    DWORD dwFilter,
                    LPVOID lpSearchCondition,
                    DWORD dwSearchCondition,
                    LPVOID lpGroupId,
                    LPVOID lpReserved )" ) || die;
ApiLink( "wininet", "BOOL FindNextUrlCacheGroup(         
                      HANDLE hFind,
                      PVOID lpGroupId,
                      LPVOID lpReserved )" ) || die;
ApiLink( "wininet", "BOOL DeleteUrlCacheGroup(         
                     DWORD GroupIdLo,
                     DWORD GroupIdHi,
                      DWORD dwFlags,
                      LPVOID lpReserved )" ) || die;
ApiLink( "wininet", "BOOL GetUrlCacheGroupAttribute(        
                      DWORD GroupIdLo,
                      DWORD GroupIdHi,
                      DWORD dwFlags,
                      DWORD dwAttributes,
                      PVOID lpGroupInfo,
                      LPDWORD lpdwGroupInfo,
                      LPVOID lpReserved )" ) || die;
ApiLink( "shell32", "HRESULT SHGetFolderPath(
                      HWND hwndOwner,
                      int nFolder,
                      HANDLE hToken,
                      DWORD dwFlags,
                      LPTSTR pszPath )" ) || die;
ApiLink( "wininet", "BOOL FindCloseUrlCache( HANDLE hEnumHandle )" ) || die;
ApiLink( "wininet", "BOOL DeleteUrlCacheEntry(LPCTSTR lpszUrlName)" ) || die;
ApiLink( "shell32.dll", "HRESULT SHEmptyRecycleBin(
                          HWND hwnd,
                          LPSTR pszRootPath,
                          DWORD dwFlags
                          )" ) || die;
ApiLink( "shell32.dll", "HRESULT SHQueryRecycleBin(
                        LPSTR pszRootPath,
                        PVOID pSHQueryRBInfo
                        )" ) || die;

##########################################################################
#
# The main code block begins here.
#
print "\n**** NOT DELETING ANY FILES ****\n\n" if( ! $Config{delete} 
&& ! $Config{silent} );

$Time{begin} = time();

print "\nDeleting cache groups.\n" if( ! $Config{silent} && ( $Config{delete} 
|| $Config{verbose} ) );
DeleteUrlCacheGroups();

print "\nDeleting cache files.\n" if( ! $Config{silent} && ( $Config{delete} 
|| $Config{verbose} ) );
DeleteUrlCacheFiles();

print "\nDeleting history files.\n" if( ! $Config{silent} && ( $Config{delete} 
|| $Config{verbose} ) );
DeleteUrlHistory();

print "\nDeleting recent files list.\n" if( ! $Config{silent} && ( $Config{delete} 
|| $Config{verbose} ) );
DeleteRecentFileList();

print "\nDeleting temporary files.\n" if( ! $Config{silent} && ( $Config{delete} 
|| $Config{verbose} ) );
DeleteTempFiles();

print "\nDeleting temporary Internet files.\n" if( ! $Config{silent} && ( $Config{delete} 
|| $Config{verbose} ) 
);
DeleteTempInternetFiles();

print "\nEmptying recycle bins.\n" if( ! $Config{silent} && ( $Config{delete} 
|| $Config{verbose} ) );
EmptyRecycleBin();

print "\nClearing IE forms data.\n" if( ! $Config{silent} && ( $Config{delete} 
|| $Config{verbose} ) );
ClearFormData();

print "\nClearing IE typed URL list.\n" if( ! $Config{silent} && ( $Config{delete} 
|| $Config{verbose} ) );
ClearTypedURLList();

print "\nClearing Explorer Run Most Recent Used (MRU) list.\n" if( ! $Config{silent} 
&& ( $Config{delete} || 
$Config{verbose} ) );
ClearRunMRU();

$Time{end} = time();
if( ! $Config{silent} )
{
  print "\n" . "=" x 40 . "\n";
  print "Totals:\n";
  foreach my $Type (sort keys %Total )
  {
    my $Size = $Total{$Type}->{_size};
    my $Count = $Total{$Type}->{_count};
    next if( "_totals" eq $Type );
    printf( "  % 20s: %s item%s (%s bytes)\n", $Type, FormatNumber( $Count ), 
( 1 == $Count)? " ":"s", 
FormatNumberPretty( $Size ) );
    $Total{_totals}->{_size} += $Size;
    $Total{_totals}->{_count} += $Count;
  }
  print "\n";
  print "  Total size: " . FormatNumberPretty( $Total{_totals}->{_size} ) . " bytes.\n";
  print "  Total count: $Total{_totals}->{_count} items.\n";
  print "  Total time taken: " . FormatNumber( $Time{end} - $Time{begin} ) . " seconds.\n";
  print "\nNote:\n";
  print "* Changes to the Windows Explorer won't show up until your next logon.\n";
  print "* Changes to Internet Explorer won't show up until you run IE again.\n";
}

##########################################################################

sub DeleteUrlCacheGroups
{
  my $pGroupId = pack( "L2", 0 );
  my $hGroup = FindFirstUrlCacheGroup( 0, $CACHEGROUP_SEARCH_ALL, 0, 0, $pGroupId, 0 );
  while( 0 != $hGroup )
  {
    my $Result;
    my( $GroupHi, $GroupLo ) = unpack( "L2", $pGroupId );
    my $pdwGroupInfoSize;
    my $pGroupInfo = pack( $CACHE_GROUP_STRUCT, 0 );
    my %Group;
    # Recreate structure this type setting the dwGroupSize member of this structure...
    $pGroupInfo = pack( $CACHE_GROUP_STRUCT, length( $pGroupInfo ), 0 );
    $pdwGroupInfoSize = pack( "L", length( $pGroupInfo ) );

    if( 0 != GetUrlCacheGroupAttribute( $GroupHi, $GroupLo, 0, 
$CACHEGROUP_ATTRIBUTE_GET_ALL,
                                        $pGroupInfo,
                                        $pdwGroupInfoSize,
                                        undef ) )
    {
      # The next assignment is to prevent strict from issuing warnings.
      {
        no strict;
        @Group{
          StructSize, Flags, Type,
          DiskUsageKB, DiskQuotaKB, Temp} = unpack( "L5a*", $pGroupInfo );
}
      @{$Group{OwnerStorage}} = unpack( "L$GROUP_OWNER_STORAGE_SIZE", $Group{Temp} );
      ($Group{Name} ) = unpack( "@" x ( 4 * $GROUP_OWNER_STORAGE_SIZE ) . "x16A*", 
$Group{Temp} );
      # Don't update the Total stats if the group name is "" and it consumes
      # 0KB on disk. This might be a bug in WinInet.
      if( ! ( "" eq $Group{Name} && 0 == $Group{DiskUsageKB} ) )
      {
        print "  Group Name: $Group{Name} (" . FormatNumberPretty( $Group
{DiskUsageKB} * 1024 ) . " 
bytes)\n" if( $Config{verbose} );
      }
    }
   
    if( $Config{delete} )
    {
      if( 0 != DeleteUrlCacheGroup( $GroupHi, $GroupLo, 
$CACHEGROUP_FLAG_FLUSHURL_ONDELETE, undef ) )
      {
      # Don't update the Total stats if the group name is "" and it consumes
      # 0KB on disk. This might be a bug in WinInet.
        if( ! ( "" eq $Group{Name} && 0 == $Group{DiskUsageKB} ) )
        {
          $Total{'Internet Cache Group'}->{_size} += $Group{DiskUsageKB} * 1024;
          $Total{'Internet Cache Group'}->{_count}++;
        }
      }
    }
   
    $Result = FindNextUrlCacheGroup( $hGroup, $pGroupId, undef );
    if( 0 == $Result )
    {
      # Continue enumerating until the Win32 error generated by FindNextUrlCacheGroup()
      # == 2 (file not found) or ERROR_NO_MORE_FILES or ERROR_NO_MORE ENTRIES 
      my $Error = Win32::GetLastError();                           
      $hGroup = 0 if( $Error == 2 || $Error == $ERROR_NO_MORE_ITEMS || $Error == 
$ERROR_NO_MORE_FILES );
    }
  }
}

sub DeleteUrlCacheFiles
{
  my $Type = shift @_;
  my $pCacheInfo = pack( "C1024", 0 );
  my $pdwSize = pack( "L", length( $pCacheInfo ) );

  my $hCache = FindFirstUrlCacheEntry( undef, $pCacheInfo, $pdwSize );
  if( 0 == $hCache && $ERROR_INSUFFICIENT_BUFFER == Win32::GetLastError() )
  {
    my $NewBufferSize = unpack( "L", $pdwSize );
    $pCacheInfo = pack( "C$NewBufferSize", 0 );
    $hCache = FindFirstUrlCacheEntry( undef, $pCacheInfo, $pdwSize );
  }

  if( 0 != $hCache )
  {
    do
    {

      my( $Temp, $dwHeaderSize ) = unpack( "A68L", $pCacheInfo );
      my $Result;
      my %Cache;
      # The next assignment is to prevent strict from issuing warnings.
      {
        no strict;
        @Cache{
          StructSize, SourceUrl, LocalFile,
          CacheEntryType, UseCount, HitRate,
          SizeLow, SizeHigh, LastModifiedTimeLow,
          LastModifiedTimeHigh, ExpireTimeLow,
          ExpireTimeHigh, LastAccessTimeLow,
          LastAccessTimeHigh, LastSyncTimeLow,
          LastSyncTimeHigh, HeaderInfo, HeaderSize,
          FileExtension, Reserved, ExemptDelta
          }  = unpack( "Lp2L5L8P" . $dwHeaderSize . "LpL2", $pCacheInfo );
      }
      my $DeleteUrl = $Cache{SourceUrl};
      my $Type = "Internet Cache";
      if( $CACHE_ENTRY{COOKIE} & $Cache{CacheEntryType} )
      {
        $Type = "Internet Cookie";
      }
      elsif( $CACHE_ENTRY{URLHISTORY} & $Cache{CacheEntryType} )
      {
        $Type = "Internet History";
      }
      print "$Type: $Cache{SourceUrl}\n" if( $Config{verbose} );
     
      $Total{$Type}->{_count}++;
      $Total{$Type}->{_size} += $Cache{SizeHigh} * (256**4) + $Cache{SizeLow};
     
      if( $Config{delete} )
      {
        if( DeleteUrlCacheEntry( $DeleteUrl ) )
        {
          print "  successfully deleted." if( $Config{verbose} );
        }
        else
        {
          print "  failed to delete." if( $Config{verbose} );
        }
      }
      print "\n" if( $Config{verbose} );
      $pdwSize = pack( "L", length( $pCacheInfo ) );
     
      # Make sure you have enough buffer space for the next
      # cached item.
      do
      {
        my $Result = FindNextUrlCacheEntry( $hCache, $pCacheInfo, $pdwSize );
        if( 0 == $Result )
        {
          my $Error = Win32::GetLastError();
          if( $Error == $ERROR_INSUFFICIENT_BUFFER )
          {
            my $NewBufferSize = unpack( "L", $pdwSize );
            $pCacheInfo = pack( "C$NewBufferSize", 0 );
          }
          elsif( $Error == $ERROR_NO_MORE_ITEMS )
          {
            # In practice, this point in the script can be reached for
            # reasons other than the specified error. 
            FindCloseUrlCache( $hCache );
            $hCache = 0;
          }
          else
          {
            print "Due to an error we are stopping enumeration of cache files.\n";
            print "  ERROR: $Error (" . Win32::FormatMessage( $Error ) . ")\n";
            FindCloseUrlCache( $hCache );
            $hCache = 0;
          }
        }
      } while( 0 != $hCache && 0 != $Result );
    } while( 0 != $hCache );
  }
}

sub DeleteUrlHistory
{
  $Total{'URL History List'} = CleanDirectory( $CSIDL_HISTORY );
}

sub DeleteTempFiles
{
  # Because we're passing in the full path (and not
  # the CSIDL value), call into RemoveDirectoryAndFiles().
  $Total{'Temporary Files'} = CleanDirectoryAndFiles( $ENV{'TEMP'} );
}

sub DeleteRecentFileList
{
  $Total{'Recent File List'} = CleanDirectory( $CSIDL_RECENT );
}

sub DeleteTempInternetFiles
{
  $Total{'Temp Internet Files'} = CleanDirectory( $CSIDL_INTERNET_CACHE );
}

sub CleanDirectory
{
  my( $FolderType ) = @_;
  my $SubTotal = {};
  my $pszPath = NewString( 1024 );
  if( 0 == SHGetFolderPath( undef, $FolderType, undef, $SHGFP_TYPE_CURRENT, 
$pszPath ) )
  {
    $pszPath =~ s/\x00//g;
    $SubTotal = CleanDirectoryAndFiles( $pszPath );
  }
  return( $SubTotal );
}

sub CleanDirectoryAndFiles
{
  my( $Dir ) = @_;
  my %SubTotal = ( '_count' => 0, '_size' => 0 );
  my( @DirList, @FileList );
  print "  Directory: '$Dir'\n" if( $Config{verbose} );
  if( opendir( DIR, $Dir ) )
  {
    while( my $Object = readdir( DIR ) )
    {
      my $Path = "$Dir\\$Object";
      next if( "." eq $Object || ".." eq $Object );
      push( @DirList, $Path ) if( -d $Path );
      # If a file exists, the script tries to remove it. The script assumes that all
      # files in the folder are OK to remove. This includes
      # (at least) index.dat and desktop.ini.
      if( -f $Path )
      {
       print "    File: '$Object'" if( $Config{verbose} );
       $SubTotal{_count}++;
       $SubTotal{_size} += ( stat( $Path ) )[7];
       if( $Config{delete} )
       {
         print "...deleting..." if( $Config{verbose} );
         if( 0 == unlink( $Path ) )
         {
           print "FAILED...rename..." if( $Config{verbose} );
           # The script is unable to delete a particular file
           # (it is probably already opened by another process), so
           # the script will attempt to rename the file to something that is no longer
           # useful.
           # But first, if a renamed index file already exists, the script deletes it.
           unlink( $Path . $DELETED_FILE_RENAME_SUFFIX );
           # The script renames the index file.
           print ( rename( $Path, $Object . $DELETED_FILE_RENAME_SUFFIX )
? "done" : "FAILED" ) if( 
$Config{verbose} );
         }
         else
         {
           print "done" if( $Config{verbose} );
         }
        }
        print "\n" if( $Config{verbose} );
      }
   
    }
    closedir( DIR );
  }
  foreach my $Path ( @DirList )
  {
    my $SubSubTotal = CleanDirectoryAndFiles( $Path );
    # The script tries to remove the folder so that in a For…Each loop it doesn’t try to remove the 
    # originally requested
    # directory (for the first iteration of this subroutine).
    # Removal of this directory will only work if there are no objects (files or directories)
    # inside it.
    $SubTotal{_count} += $SubSubTotal->{_count};
    $SubTotal{_size} += $SubSubTotal->{_size};
    rmdir( $Path ) if( $Config{delete} );
  }
  return( \%SubTotal );
}

sub ClearTypedURLList
{
  $Total{'Typed URL List'} = ClearRegistryKey( $::HKEY_CURRENT_USER, 
$REGISTRY_KEY{typed_url_list} );
}

sub ClearFormData
{
  $Total{'Forms Data'} = ClearRegistryKey( $::HKEY_CURRENT_USER, 
$REGISTRY_KEY{intelliforms_data} );
}

sub ClearRunMRU
{
  $Total{'Run MRU List'} = ClearRegistryKey( $::HKEY_CURRENT_USER, 
$REGISTRY_KEY{explorer_run_mru} );
}

sub ClearRegistryKey
{
  my( $Root, $Path ) = @_;
  my $Key;
  my %Data;
  print "  Registry: $Path\n" if( $Config{verbose} );
  if( $Root->Open( $Path, $Key ) )
  {
    my %List;
    $Key->GetValues( \%List );
    foreach my $ValueName ( sort keys %List )
    {
      print "    $ValueName => '$List{$ValueName}->[2]'\n" if( $Config{verbose} );
      $Key->DeleteValue( $ValueName ) if( $Config{delete} );
      $Data{_count}++;
      $Data{_size} += length( $List{$ValueName}->[2] );
    }
    $Key->Close();
  }
  return( \%Data );
}

sub EmptyRecycleBin
{
  # $Path specifies which Recycle Bin to empty. An empty string means to
  # empty all Recycle Bins from the computer.
  my $Path = ""; 
  $Total{'Recycle bins'} = QueryRecycleBin();
  SHEmptyRecycleBin( undef, $Path, $SHERB_NOCONFIRMATION | $SHERB_NOPROGRESSUI | 
$SHERB_NOSOUND ) if( $Config{delete} );
}

sub QueryRecycleBin
{
  my $pQueryBinInfo;
  my $Result;
  my $Size;
  my $Count;
  $pQueryBinInfo = pack( $QUERY_RECYCLE_BIN_STRUCT, 0,0,0,0 );
  $pQueryBinInfo = pack( $QUERY_RECYCLE_BIN_STRUCT, length($pQueryBinInfo),0,0,0 );
  $Result = SHQueryRecycleBin( "", $pQueryBinInfo );
  if( 0 == $Result )
  {
    my( undef, $SizeLo, $SizeHi, $CountLo, $CountHi ) = unpack( $QUERY_RECYCLE_BIN_STRUCT, 
$pQueryBinInfo );
    $Size = $SizeLo + $SizeHi * (256**4);
    $Count = $CountLo + $CountHi * (256**4);
  }
  return( { _size => $Size, _count => $Count } );
}

sub FormatNumber
{
  my( $Number ) = @_;
  $Number = 0 if( "" eq $Number );
  while( $Number =~ s/^(-?\d+)(\d{3})/$1,$2/ ){};
  return( $Number );
}

sub FormatNumberPretty
{
  my( $Number ) = @_;
  my $Suffix = "";
  if( $Number >= $TERABYTE )
  {
    $Number /= $TERABYTE;
    $Suffix = "T";
  }
  elsif( $Number >= $GIGABYTE )
  {
    $Number /= $GIGABYTE;
    $Suffix = "G";
  }
  elsif( $Number >= $MEGABYTE )
  {
    $Number /= $MEGABYTE;
    $Suffix = "M";
  }
  elsif( $Number > $KILOBYTE )
  {
    $Number /= $KILOBYTE;
    $Suffix = "K";
  }
  $Number = sprintf( "%0.2f", $Number );
  return( FormatNumber( $Number ) . $Suffix );
}

sub Configure
{
  my( $Config ) = @_;
  my $Result;
  Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
  $Result = GetOptions( $Config, qw(
                        delete|d
                        verbose|v
                        silent|s
                        help|?
                        ) );
  $Config->{verbose} = 0 if( $Config->{silent} );
  return( $Result );
}

sub Syntax
{
  print<<"EOT";
    $0
    This will delete everything in the Internet cache. This includes URL
    history, cached files and cookies.
                                     
    Syntax:
      $0 [/d][/v][/s][/?]
     
      /d...........Delete the entries found.
      /v...........Verbose mode. Display additional information.
      /s...........Silent mode. Don't display any text.
                   This overrides Verbose mode.
      /?...........Display this help message.
EOT
}