Hi Brother Anonymous
Here is a Win32::TieRegistry example that works for me.
Notice setting the Delimiter and ArrayValues options.
You have to work your way around those pesky slashes - not too many, not too few, and in the right spots.
When you get hold of a registry tree that you are interested in - like
$Registry->{"$keyclsids/$matchedclsid"} in the example below,
you can use Data::Dumper to see the Perl structures that it contains,
perhaps comparing with what you see with the Regedit tool.
From this you can work out your next moves.
Here's an exercice for you: modify the program below so that it also prints
the full path to the dll (InprocServer32) that houses each of those Perl-related objects.
HTH
Rudif
#! perl -w
use strict;
use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>0 ); # initializ
+es $Registry
# get all CLSIDs and find those with ProgID matching /Perl/
#
my $keyclsids = "HKEY_CLASSES_ROOT/CLSID";
my $refclsids = $Registry->{$keyclsids};
my $match = "Perl";
my ($i, $m, $clsid, $matchedclsid);
for (keys %$refclsids) {
++$i;
($clsid = $_) =~ s!/$!!; # remove the trailing '/'
my $keyprogid = "$keyclsids/$clsid/ProgID//";
if (exists $Registry->{"$keyprogid"}) {
my $progid = $Registry->{"$keyprogid"};
next unless $progid =~ /$match/;
++$m;
$matchedclsid = $clsid;
printf STDERR "==$i== CLSID=$clsid, ProgID=$progid\n";
}
}
printf STDERR "... found %d CLSIDs, of which %d had a ProgID matching
+/%s/\n", scalar keys %$refclsids, $m, $match;
# now dump the Registry tree at the last maching CLSID
#
use Data::Dumper;
print Dumper( $Registry->{"$keyclsids/$matchedclsid"} );
__END__
### printout from above script:
==1640== CLSID={6CD9A328-775D-11CF-B2C2-0080C8107984}, ProgID=PerlDebu
+gger.Document
==2056== CLSID={8888FF13-7A60-11D2-AE59-00A0C95D4A9C}, ProgID=PerlDB.S
+ync.1
==2458== CLSID={B5863EF3-7B28-11D1-8106-0000B4234391}, ProgID=PerlCOM.
+Script.1
==3438== CLSID={F8D77580-0F09-11D0-AA61-3C284E000000}, ProgID=PerlScri
+pt
... found 3537 CLSIDs, of which 4 had a ProgID matching Perl
(in cleanup) Can't call method "FETCH" on an undefined value at C:
+/Perl/site/lib/Win32/TieRegistry.pm line 1486 during global destructi
+on.
$VAR1 = bless( {
'AuxUserType/' => bless( {}, 'Win32::TieRegistry' ),
'Implemented Categories/' => bless( {
'{F0B7A1A1-9847
+-11CF-8F20-00805F2CD064}/' => bless( {}, 'Win32::TieRegistry' ),
'{F0B7A1A2-9847
+-11CF-8F20-00805F2CD064}/' => bless( {}, 'Win32::TieRegistry' )
}, 'Win32::TieReg
+istry' ),
'InprocServer32/' => bless( {
'/' => 'C:\\Perl\\bin\\
+PerlSE.dll',
'/ThreadingModel' => 'B
+oth'
}, 'Win32::TieRegistry' )
+,
'OLEScript/' => bless( {}, 'Win32::TieRegistry' ),
'ProgID/' => bless( {
'/' => 'PerlScript'
}, 'Win32::TieRegistry' ),
'/' => 'PerlScript Language'
}, 'Win32::TieRegistry' );
(28 sec).
|