Generated: Sun Aug 21 11:11:24 2011 from regclass.pl 2010/10/23 10.8 KB.
#!/Perl # NAME: regclass.pl # AIM: To explore the File Type associations in the registry, # printing out all extensions found, and then enumerating the # association to each extension (suffix if you will). # 23/10/2010 - Review, and add input of an extension # geoff mclane - http:\\geoffmclane.com - updated 20070402, commenced 20070120 # NOTES: # This is in Windows XP Pro - it enumerates HKEY_CLASSES_ROOT # The four top-level objects are: $HKEY_CLASSES_ROOT $HKEY_CURRENT_USER $HKEY_LOCAL_MACHINE $HKEY_USERS # It does NOT resolve the indirect 'openwith' entries # Turning on $dbg1 will show LOTS of enumeration ouput. # It was mainly written as an 'exercise' in enumerating the registry, recursively ... # It uses my logfile.pl, but this could be removed... use strict; use warnings; use Win32::Registry; use Data::Dumper; my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); require 'logfile.pl' or die "ERROR: Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # features my $load_log = 0; my $in_file = ''; my $show_all = 0; # debug my $debug_on = 0; my $def_file = '.dsp'; my $dbg1 = 0; # do output during enumeration my %TYPES = ( ®_SZ => "REG_SZ", ®_EXPAND_SZ => "REG_EXPAND_SZ", ®_MULTI_SZ => "REG_MULTI_SZ", ®_DWORD => "REG_DWORD", ®_BINARY => "REG_BINARY" ); my $keypath = ''; my $keyroot = $HKEY_CLASSES_ROOT; my $acnt = 0; my $vcnt = 0; my %assoc = (); # association for each extension my %apps = (); my $maxext = 0; my $maxass = 0; my $maxnum = 0; my ($key,$val); my $ext_cnt = 0; my @warnings = (); my $os = $^O; sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { #prt( "\nNo warnings issued.\n\n" ); } } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } show_warnings($val); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub trimall($) { my ($ln) = shift; chomp $ln; # remove CR (\n) $ln =~ s/\r$//; # remove LF (\r) $ln =~ s/\t/ /g; # TAB(s) to a SPACE while ($ln =~ /\s\s/) { $ln =~ s/\s\s/ /g; # all double space to SINGLE } while ($ln =~ /^\s/) { $ln = substr($ln,1); # remove all LEADING space } while ($ln =~ /\s$/) { $ln = substr($ln,0, length($ln) - 1); # remove all TRAILING space } return $ln; } # take something like - # $VAR1 = bless( { # 'handle' => '-2147483648' # }, 'Win32::Registry' ); # and RETURN one line, like # bless( { 'handle' => '-2147483648' }, 'Win32::Registry' ); sub get_short_dump { my ($v) = shift; my $d = Dumper($v); my @lns = split(/\n/, $d); my $cnt = scalar @lns; my $res = ''; my @a = (); my $i = 0; if ($cnt > 1) { for ($i = 0; $i < $cnt; $i++) { $res .= ' ' if (length($res)); if ($i == 0) { @a = split(/=/, trimall( $lns[$i] )); $res = trimall( $a[-1] ); } else { $res .= trimall( $lns[$i] ); } } } else { @a = split(/=/, trimall( $lns[$i] )); $res = trimall( $a[-1] ); $res =~ s/'//g; $res =~ s/;$//; } return $res; } sub show_keys($$$); sub show_keys($$$) { my ($k,$p,$lev) = @_; my $Key; my %Values; my @KeyList; my $msg = ''; my $sdp = get_short_dump($p); if (length($sdp) == 0) { $sdp = '<none>'; } if ($lev == 1) { prt("\n") if ($dbg1); } if( $k->Open( $p, $Key ) ) { $Key->GetKeys( \@KeyList ); my $pc = scalar @KeyList; my $cnt = 0; if( $Key->GetValues( \%Values ) ) { my $vcnt = scalar keys(%Values); if ($vcnt > 0) { prt( "Found $vcnt values on path [$sdp] ... ($lev)\n" ) if ($dbg1); $vcnt = 0; # reset count foreach my $ValueName ( sort( keys( %Values ) ) ) { $vcnt++; my $Name = $Values{$ValueName}->[0]; my $Type = $Values{$ValueName}->[1]; my $Data = $Values{$ValueName}->[2]; my $tname = $TYPES{$Type}; my $nm = $Name; my $len = 0; if (defined $Data) { $len = length($Data); } if (length($nm) == 0) { $nm = '<none>'; } prt( "$vcnt [$sdp] [$nm] ($tname) Data = [$Data] ($lev)\n" ) if ($dbg1); if (($lev == 1) && ($vcnt == 1)) { if ( defined($assoc{$sdp}) ) { $assoc{$sdp} = $Data; } else { prt( "NOTE: Creating NEW extension, association!!!\n" ) if ($dbg1); $assoc{$sdp} = $Data; } $maxass = $len if ($len > $maxass); } } } else { prt( "Found NO values on path [$sdp] ... ($lev)\n" ) if ($dbg1); } } prt( "Found $pc keys on path [$sdp] ... ($lev)\n" ) if ($dbg1); $msg = ''; foreach my $k2 (@KeyList) { if ($lev == 0) { if ($k2 =~ /^\./) { # ONLY want the EXTENSION list - ie .something $cnt++; $msg .= " $k2"; if ( defined($assoc{$k2}) ) { if ( length($msg) ) { prt( "$cnt $msg ($lev)\n" ); $msg = ''; } prt( "\nWARNING: Extension [$k2] already exists ... ($lev)\n" ); } $assoc{$k2} = 'unknown'; # start out UNKNOWN! $maxext = length($k2) if (length($k2) > $maxext); } } else { $cnt++; $msg .= " $k2"; } if (length($msg) > 76) { prt( "$cnt $msg ($lev)\n" ) if ($dbg1); $msg = ''; } } prt( "$cnt $msg ($lev)\n" ) if (length($msg) && $dbg1); prt( "Found $cnt extensions. Now explore associations ...\n" ) if ($lev == 0); $Key->Close(); $p .= "\\" unless ( "" eq $p ); foreach my $SubKey ( sort ( @KeyList ) ) { if ($lev == 0) { if ($SubKey =~ /^\./) { show_keys( $k, $p . $SubKey, ($lev + 1) ); } } else { show_keys( $k, $p . $SubKey, ($lev + 1) ); } } } else { prt( "Failed to open path [$sdp] ... ($lev)\n" ); } } sub prt31($$$) { my ($n, $k, $v) = @_; my $m = "$n"; while (length($m) < $maxnum) { $m = ' '.$m; } while (length($k) < $maxext) { $k .= ' '; } prt( "$m $k = $v\n" ); } sub prt32($$$) { my ($n, $k, $v) = @_; my $m = "$n"; while (length($m) < $maxnum) { $m = ' '.$m; } while (length($k) < $maxass) { $k .= ' '; } prt( "$m $k = $v\n" ); } # =============================================== # ### MAIN ### parse_args(@ARGV); # start at the root - enumerate key list prt("Enumerating key list of [HKEY_CLASSES_ROOT]...\n"); show_keys($keyroot, $keypath, 0); $acnt = scalar keys %assoc; # association for each extension $ext_cnt = $acnt; prt( "Done - Have $ext_cnt extensions to list ...\n" ); if ($acnt > 99999) { $maxnum = 6; } elsif ($acnt > 9999) { $maxnum = 5; } elsif ($acnt > 999) { $maxnum = 4; } elsif ($acnt > 99) { $maxnum = 3; } elsif ($acnt > 9) { $maxnum = 2; } else { $maxnum = 1; } $acnt = 0; if (length($in_file)) { my $fnd = 0; foreach $key (keys %assoc) { $acnt++; $val = trimall($assoc{$key}); if ((length($val) == 0) || ($val eq 'unknown')) { $val = 'Unknown'; } if ($key eq $in_file) { prt31( $acnt, $key, $val ); $fnd++; } } prt("Extension [$in_file] NOT found in $acnt keys...\n") if ($fnd == 0); } if ($show_all) { $acnt = 0; prt( "First - unknown or <blank> values ...\n" ); foreach $key (sort keys %assoc) { $val = trimall($assoc{$key}); if ((length($val) == 0) || ($val eq 'unknown')) { $acnt++; prt31( $acnt, $key, $val ); } } prt( "\nThen apparently VALID associations ...\n" ); $vcnt = 0; foreach $key (sort keys %assoc) { $val = trimall($assoc{$key}); if ((length($val) == 0) || ($val eq 'unknown')) { ### done } else { $acnt++; if ( defined( $apps{$val} ) ) { $apps{$val} .= ', '.$key; } else { $apps{$val} = $key; } prt31( $acnt, $key, $val ); $vcnt++; } } prt( "Done list $acnt extensions ... $vcnt with associated applications ...\n" ); $acnt = scalar keys %apps; prt( "\nThese $vcnt extensions are associated to $acnt applications ...\n" ); $acnt = 0; foreach $key (sort keys %apps) { $val = $apps{$key}; $acnt++; prt32( $acnt, $key, $val ); } prt( "Done list $acnt applications... for $ext_cnt extensions found...\n" ); } pgm_exit(0,""); # =================================================== ######################################## sub give_help { prt("$pgmname: version 0.0.3 2010-10-23\n"); prt("Usage: $pgmname [options] [extension]\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --load-log (-l) = Load log file at end.\n"); prt(" --show-all (-s) = Show the full list of extensions, and associations.\n"); prt("Purpose:\n"); prt(" To enumerate the HKEY_CLASSES_ROOT registry key, and find\n"); prt(" the given extension, like say '.dsp'. If no 'extension' given, then will\n"); prt(" default to showing ALL.\n"); } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg); while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^l/i) { $load_log = 1; } elsif ($sarg =~ /^s/i) { $show_all = 1; } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; prt("Set input extension [$in_file]\n"); } shift @av; } if ((length($in_file) == 0) && $debug_on) { $in_file = $def_file; } if (length($in_file) == 0) { prtw("WARNING: No input extension found in command! Will show ALL...\n"); $show_all = 1; $load_log = 1; } } # eof - regclass.pl