Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Windows Registry tool

by hopes (Friar)
on Jul 16, 2002 at 22:52 UTC ( [id://182253]=CUFP: print w/replies, xml ) Need Help??

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
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://182253]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others about the Monastery: (7)
As of 2024-03-28 11:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found