Листинг 1. Фрагменты сценария DumpStartups.pl

use Getopt::Long;
use Win32::API::Prototype;
use Win32::TieRegistry;
use Win32::Shortcut;
use Win32::AdminMisc;
use strict;
use vars qw( %HIVES %PATHS %Config $Value
    $EXECUTABLE_EXTENSIONS
 $CSIDL_STARTUP
 $CSIDL_COMMON_STARTUP
 $SHGFP_TYPE_CURRENT );
%HIVES = (
 CUser => «HKCU»,
 LMachine => «HKLM»,
 Drive => «Drive»,
);
Начало фрагмента A
ApiLink( «shell32», «HRESULT SHGetFolderPath(
 HWND hwndOwner,
 int nFolder,
 HANDLE hToken,
 DWORD dwFlags,
 LPTSTR pszPath )» ) || die;
$CSIDL_STARTUP = 0x0007; # Start MenuProgramsStartup — 
$CSIDL_COMMON_STARTUP = 0x0018; # UsersStartup
$SHGFP_TYPE_CURRENT = 1; # Current value (not default)
конец фрагмента A
Начало фрагмента B
BEGIN COMMENT LINE
# если переменная окружения PATHEXT отсутствует, создадим ее
END COMMENT LINE
$ENV{PATHEXT} = «.cmd;.com;.bat;.vbs;» unless( «» ne $ENV{PATHEXT} );
$EXECUTABLE_EXTENSIONS = join( «|», ( split( «;», $ENV{PATHEXT} . «;.pif;.lnk» ) ) );
конец фрагмента B
.
.
.
Начало фрагмента C
foreach my $Path ( @{$PATHS{registry}} )
{
 push( @RunValues, ProcessKey( $Path ) );
}
foreach my $Path ( @{$PATHS{file}} )
{
 push( @RunValues, ProcessDir( $Path ) );
}
конец фрагмента C
$~ = «DumpHeader»;
write;
$~ = «DumpData»;
Начало фрагмента D
if( scalar @{$Config{remove}} )
{
 foreach my $Index ( @{$Config{remove}} )
 {
 local $Value;
 $Value = $RunValues[ $Index ];
 $Value->{_index} = $Index;
 Remove( $Value );
BEGIN COMMENT LINE
 # Запись после вызова Remove(). Команда write может удалить
 # некоторые элементы хеша $Value
END COMMENT LINE
 write;
 }
}
else
{
 my $TotalIndex = scalar @RunValues;
 for( my $Index = 0; $Index < $TotalIndex; $Index++ )
 {
 local $Value;
 $Value = $RunValues[ $Index ];
 $Value->{_index} = $Index;
 write;
 }
}
конец фрагмента D
sub ProcessKey
{
 my( $Path ) = @_;
 my @ValueList = ();
Начало фрагмента E
 my( $Location ) = ( $Path =~ //([^/]+)// );
BEGIN COMMENT LINE
 # Открываем раздел реестра с правами доступа MAXIMUM_ALLOWED
END COMMENT LINE
 if( my $Key = $Registry->Open( $Path, {Access => 0x2000000} ))
 {
 foreach my $ValueName ( $Key->ValueNames() )
 {
 # предполагается, что все эти значения строкового типа....
 my $Data = $Key->{ «/$ValueName» };
 push( @ValueList, { _name => $ValueName, _path => $Path, _data => $Data, _location => $Location 
} );
 }
 }
 return( @ValueList );
конец фрагмента E
}
sub ProcessDir
{
 my( $Dir ) = @_;
 my @ValueList = ();
 my @DirList = ();
 if( opendir( STARTUP_DIR, $Dir ) )
 {
 while( my $File = readdir( STARTUP_DIR ) )
 {
 my $Path = «$Dir/$File»;
 next if( «.» eq $File || «..» eq $File );
 if( -d $Path )
 {
 push( @DirList, $Path );
 next;
 }
 if( $File =~ /.lnk$/i )
 { 
Начало фрагмента F
 # Process Shortcut...
 my $Shortcut = new Win32::Shortcut( $Path );
 my $Name = $Shortcut->{Description};
 if( «» eq $Name )
 {
 my %FileInfo;
 if( Win32::AdminMisc::GetFileInfo( $Shortcut->{Path}, \%FileInfo ) )
 {
 $Name = $FileInfo{FileDescription} || $File;
 }
 }
 push( @ValueList, { _name => $Name, _path => $Path, _data => «»$Shortcut->{Path}» $Shortcut-
>{Arguments}», _location => «Drive» } );
конец фрагмента F
 }
 elsif( $File =~ /($EXECUTABLE_EXTENSIONS)$/i )
 {
Начало фрагмента G
 # Process other files...
 my $Name = $File;
 my %FileInfo;
 if( Win32::AdminMisc::GetFileInfo( $Path, \%FileInfo ) )
 {
 $Name = $FileInfo{FileDescription} if( «» ne $FileInfo{FileDescription} );
 }
 push( @ValueList, { _name => $Name, _path => $Path, _data => $Path, _location => «Drive» } );
 }
конец фрагмента G
 }
 closedir( STARTUP_DIR );
 foreach my $Path ( @DirList )
 {
 push( @ValueList, ProcessDir( $Path ) );
 }
 }
 return( @ValueList );
}
.
.
.
Начало фрагмента H
 if( «drive» eq lc $Item->{_location} )
 {
 BEGIN COMMENT LINE
	# Это файл на диске
	END COMMENT LINE
 print «Deleting file: ?$Item->{_path}?
»;
 $Result = unlink( $Item->{_path} );
 }
 else
 {
BEGIN COMMENT LINE
 # Раздел реестра.
END COMMENT LINE
 my $Path = «$Item->{_path}/$Item->{_name}»;
 $Result = delete $Registry->{$Path};
 print «Deleting reg key value: ?$Path?
»;
 }
конец фрагмента H
 if( $Result )
 {
 print «REMOVED!
»;
 }
 else
 {
 print «FAILED to remove! Error: « . Win32::FormatMessage( Win32::GetLastError() );
 }
 }
 else
 {
 print « WILL NOT REMOVE $Item->{_name}!
»;
 }
}
Начало фрагмента I
sub GetSpecialDirectory
{
 my( $FolderType ) = @_;
 my $pszPath = NewString( 1024 );
 if( 0 == SHGetFolderPath( undef, $FolderType, undef, $SHGFP_TYPE_CURRENT, $pszPath ) )
 {
 $pszPath =~ s/x00//g;
 return( $pszPath );
 }
 return( undef );
}
конец фрагмента I