#  RegFind.pl
#  Example 3.14:
#  ----------------------------------------
#  From "Win32 Perl Scripting: Administrators Handbook" by Dave Roth
#  Published by New Riders Publishing.
#  ISBN # 1-57870-215-1
#
#  This script walks through the registry looking for a given string.
#
print "From the book 'Win32 Perl Scripting: The Administrator's Handbook' by Dave Roth\n\n";

          
use Getopt::Long;
use Win32::Registry;

%HIVE_LIST = (
  HKEY_LOCAL_MACHINE  =>  $HKEY_LOCAL_MACHINE,
  HKEY_CURRENT_USER   =>  $HKEY_CURRENT_USER,
  HKEY_CLASSES_ROOT   =>  $HKEY_CLASSES_ROOT,
  HKEY_USERS          =>  $HKEY_USERS,
  HKEY_CURRENT_CONFIG =>  $HKEY_CURRENT_CONFIG,
);
%HIVE_LIST_ABBR = (
  HKLM        =>  $HKEY_LOCAL_MACHINE,
  HKCU        =>  $HKEY_CURRENT_USER,
  HKCR        =>  $HKEY_CLASSES_ROOT,
  HKU         =>  $HKEY_USERS,
  HKCC        =>  $HKEY_CURRENT_CONFIG,
);
foreach my $Key ( keys( %HIVE_LIST ) )
{
  $HIVE_LIST_REVERSE{$HIVE_LIST{$Key}} = $Key;
}
$iTotalKeys = $iTotalMatch = 0;
Configure( \%Config );
if( $Config{help} )
{
  Syntax();
  exit();
}

while( my $Path = shift @{$Config{paths}} )
{
  my( $Temp, $Machine, $Hive ) = ( $Path =~ /^((\\\\.*?)\\)?(.*)/ );
  my( $Hive, $Temp2, $Path ) = ( $Hive =~ /^([^\\]*)(\\(.*))?/ );
  my $Root = OpenHive( $Hive, $Machine );
  if( 0 != $Root )
  {
    my @Keys;
    my @List;

    if( "" ne $Machine )
    {
      $Hive = "$Machine\\$Hive";
    }
    
    if( $Root->Open( $Path, $Key ) )
    {
      $Path = "\\$Path" if( "" ne $Path );
      print "Scanning $Hive$Path\n";
      ProcessKey( $Key, "$Hive$Path", $KeyName );
    }
    else
    {
      print "Unable to open $Hive\\$Path\n";
    }
    $Root->Close();
  }
  else
  {
      # Can not connect.
  }
}

print STDERR "\n-------------------\n";
print STDERR "Total values checked: $iTotalKeys\n";
print STDERR "Total values matching criteria: $iTotalMatch\n";

sub OpenHive
{
  my( $Hive, $Machine ) = @_;
  my $Root;
  my $HiveKey = $HIVE_LIST_ABBR{uc $Hive};

  if( "Win32::Registry" ne ref $HiveKey )
  {
    $HiveKey = $HIVE_LIST{uc $Hive}
  }

  if( "" ne $Machine )
  {
    if( ! $HiveKey->Connect( $Machine, $Root ) )
    {
      print STDERR "Could not connect to '$Machine'\n";
      $Root = 0;
    }
  }
  else
  {
    $Root = $HiveKey;
  }
  return( $Root );
}

sub ProcessKey
{
  my( $Key, $Path, $KeyName ) = @_;
  my $TempKey;
  
  if( $Key->Open( $KeyName, $TempKey ) )
  {
    my( $SubKey, $Value, @Keys, %Values, $iCount );
    my $ThisPath = $Path;
    $ThisPath .= "\\$KeyName" if( "" ne $KeyName );
    if( $TempKey->GetValues( \%Values ) )
    {
      foreach my $Value ( sort( keys( %Values ) ) )
      {
        my( $Name, $Type, $Data ) = @{$Values{$Value}};
        $iTotalKeys++;
        printf( STDERR "% 10s keys checked; %s matched.\r", 
                       FormatNumber( $iTotalKeys ), 
                       FormatNumber( $iTotalMatch ) );
        foreach my $Target ( @{$Config{target}} )
        {
          if( "$Name\x00$Data" =~ /$Target->{find}/i )
          {
            if( REG_BINARY == $Type )
            {
              $Data = "<Binary Data>";
            }
            print STDERR " " x 60, "\r";
            printf( STDOUT " % d) %s\\%s: (%s) '%s'\n", 
                           ++$iTotalMatch, 
                           $ThisPath, 
                           $Value, 
                           ValueType( $Type ), 
                           $Data );
          }
        }
      }
    }
    $TempKey->GetKeys( \@Keys );
  
    foreach $SubKey ( sort( @Keys ) )
    {
        ProcessKey( $TempKey, $ThisPath, $SubKey );
    }
    $TempKey->Close();
  }
}

sub ValueType
{
  my( $Type ) = @_;
  my( $ValueType );
  
  if( REG_SZ == $Type )
  {
    $ValueType = "REG_SZ";
  }
  elsif( REG_EXPAND_SZ == $Type )
  {
    $ValueType = "REG_EXPAND_SZ";
  }
  elsif( REG_MULTI_SZ == $Type )
  {
    $ValueType = "REG_MULTI_SZ";
  }
  elsif( REG_DWORD == $Type )
  {
    $ValueType = "REG_DWORD";
  }
  elsif( REG_BINARY == $Type)
  {
    $ValueType = "REG_BINARY";
  }
  else
  {
    $ValueType = "Unknown Type";
  }
  return( $ValueType );
}

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

sub Configure
{
  my( $Config ) = @_;
  my $Result;

  Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
  $Result = GetOptions( $Config, 
                        qw(
                          paths|p=s@
                          help|?|h
                        )
  );
  foreach my $Target ( @ARGV )
  {
    push( @{$Config->{target}}, { find => $Target } );
  }
  if( ! scalar @{$Config->{paths}} )
  {
    push( @{$Config->{paths}}, 'HKLM' );
  }
  $Config->{help} = 1 unless( scalar @{$Config->{target}} );
  $Config->{help} = 1 unless( $Result );
  return;
}

sub Syntax
{
    my( $Script ) = ( $0 =~ m#([^\\/]+)$# );
    my $Line = "-" x length( $Script );
    print << "EOT";

    $Script
    $Line
    Locates specified strings in the registry.
    Syntax: $Script [-p <path>]<find> [<find2> ...]
      Path..........Registry path to look into such as 
                    HKEY_LOCAL_MACHINE or HKEY_CURRENT_USER
                    Abbreviations are allowed (eg. HKLM).
                    Default: HKEY_LOCAL_MACHINE
      Find..........String to search for.

      Remote registries are allowed by prepending a machine name
      such as: \\\\server1\\hklm\\software

EOT
}