Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Windows Registry tool

by hopes (Friar)
on Jul 16, 2002 at 22:52 UTC ( #182253=snippet: print w/replies, xml ) Need Help??
Description: This is a script I wrote to list registry keys in Win32.
I used to use regedit.exe or regedt32.exe.
But it is too slow when there are a lot of subkeys in a key, or connecting to a remote machine.
Because of this I wrote regtool.pl
Commands:
Change current key:
cd key
List a key:
dir key (also 'ls')
Quit
quit (also 'exit')
I hope it results useful. Regards. Hopes
use Win32::TieRegistry;
use strict;
use vars qw($pound $key);

my %regtypes = (1=>'REG_SZ', 2=> 'REG_EXPAND_SZ', 3=>'REG_BINARY', 4=>
+'REG_DWORD', 7=>'REG_MULTI_SZ');

sub ListKey
{
    #$RRef is a TieRegistry ref
    my $RRef = shift;
    for my $key ($RRef->SubKeyNames)    {
        print "[$key]\n";
    }
    for my $key ($RRef->ValueNames)    {
        my ($ValueData,$ValueType)= $RRef->GetValue( $key );
        $key = "(Default)" unless $key;
        if ($regtypes{$ValueType} eq 'REG_BINARY')     {
           $ValueData = unpack ("H*", $ValueData);
           $ValueData =~ s/([0-9a-f]{2})/$1 /gi;
        }
        elsif ($regtypes{$ValueType} eq 'REG_MULTI_SZ')     {
              $ValueData= join "\n\t",@$ValueData;
        }
        print "$key ($regtypes{$ValueType})\n\t$ValueData\n";
    }        
    printf ("%0d keys, %0d values", scalar $RRef->SubKeyNames, scalar 
+$RRef->ValueNames);
}

sub ExtendedPath
{
    my $rpath=shift;
    $$rpath =~ s|/?[^/]*/\.\.||g;
}

sub PrintHelp
{
    print "\nregtool.pl commands:";
    print "\n--------------------\n";
    print "Change current key:\n";
    print "\tcd  [key]\n";
    print "List a key:\n";
    print "\tdir [key] (also 'ls')\n";
    print "Quit\n";
    print "\tquit (also 'exit')\n";
}

if (lc $ARGV[0] eq 'help')    {
    PrintHelp();
    exit(0);
}

#First of all, the registry delimiter (to avoid backslashing)
$pound= $Registry->Delimiter("/");
#Without these two lines, we can't read REG_MULTI_SZ or REG_EXPAND_SZ 
+keys
$Registry->FixSzNulls(1);
$Registry->SplitMultis(1);
#If there is a parameter, we will try to use it as "current key"
my $subkey = shift;
eval {
     $Registry->Open($subkey);
};
#If there is an error, current key is the root of the registry
$subkey ="" if ($@);
for (;;)    {
    #Interactive Mode
    #First, we print the prompt (path and $)
    print "\n$subkey \$: ";
    #Read the command
    my $command = <STDIN>;
    chomp $command;
    my @commands = split /\s+/, $command;
    if (lc $command eq 'quit' or lc $command eq 'exit')    {
        last;
    }
    elsif ( lc $commands[0] eq 'dir' or lc $commands[0] eq 'ls') {
        #List command
        #If there is a paremeter, could be a key that we want to list
        $commands[1] = $subkey unless $commands[1];
        ExtendedPath(\$commands[1]);
        #If no, we'll list the current key
        eval    {
            $key = $Registry->Open($commands[1]);
        };
            if ($@ or ref $key ne 'Win32::TieRegistry')    {
                #If error, $commands[1] maybe a relative path
            eval    {
                my $path = "$subkey/$commands[1]";
                       ExtendedPath(\$path);
                $key = $Registry->Open($path);
            };
                if ($@ or ref $key ne 'Win32::TieRegistry')    {
                print "Error: $commands[1] doesn't exist\n";
                next;
                }
        }
            ListKey($key);
    }
    elsif (lc $commands[0] eq 'cd')             {
        #"Change Directory" command
        unless ($commands[1])    {
            #If not parameter, "current key" is shown
            print "$subkey\n";
        }
        #If there is a paremeter, we try to open this registry key
        eval {
            $key = $Registry->Open($commands[1]);
        };
        if ($@ or ref $key ne 'Win32::TieRegistry')      {
            #If error, may be a "relative path" to the current key
                   eval {
                       my $path = "$subkey/$commands[1]";
                       ExtendedPath(\$path);
                       $key = $Registry->Open($path);
                   };
               if ($@ or ref $key ne 'Win32::TieRegistry')    {
                       print "Error: $commands[1] doesn't exist\n";
                       next;
               }
               else {
                   $commands[1]="$subkey/$commands[1]";
                   ExtendedPath(\$commands[1]);
               }
        }
        $subkey = $commands[1]; 
    }
    elsif (lc $commands[0] eq 'help')    {
        PrintHelp();
    }
    else {
         print "$commands[0] is not a valid command, type 'help' if yo
+u need help\n";
    }
}
Replies are listed 'Best First'.
Re: Windows Registry tool
by Courage (Parson) on Jul 20, 2002 at 08:58 UTC
    Earlier I wondered is it only me who notices such low quality of regedit?
    Thank you for your code which is good and yet answers my old question :)

    BTW now I think it's worth reimplement regedit.exe using perl+Tk.

    Courage, the Cowardly Dog.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://182253]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (11)
As of 2020-09-21 20:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I donít succeed, I Ö










    Results (127 votes). Check out past polls.

    Notices?