Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
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 making s'mores by the fire in the courtyard of the Monastery: (2)
As of 2024-04-26 03:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found