104 lines
2.6 KiB
Perl
104 lines
2.6 KiB
Perl
use Win32::Registry;
|
|
|
|
my ($type, $value, $uc, $urt);
|
|
my $version = "";
|
|
my $ms = "";
|
|
|
|
###
|
|
### It appears that if you install recent URT builds and then uninstall,
|
|
### the entire .NETFramework key gets blown away. Thus, we'll create it if
|
|
### so necessary.
|
|
###
|
|
if (!$::HKEY_LOCAL_MACHINE->Open('SOFTWARE\Microsoft\.NETFramework', $urt)) {
|
|
###
|
|
### This cannot fail (right?).
|
|
###
|
|
if (!$::HKEY_LOCAL_MACHINE->Open('SOFTWARE\Microsoft', $ms)) {
|
|
die "Couldn't open HKLM\Software\Microsoft key: $!\n";
|
|
}
|
|
|
|
$ms->Create('.NETFramework', $value);
|
|
$::HKEY_LOCAL_MACHINE->Open('SOFTWARE\Microsoft\.NETFramework', $urt);
|
|
}
|
|
|
|
if ($urt->Open('policy\v1.0', $policy)) {
|
|
###
|
|
### This machine has some version of the URT installed.
|
|
###
|
|
|
|
$policy->GetValues(\%values);
|
|
foreach (sort(keys(%values))) {
|
|
if (/^\d+$/) {
|
|
$version = $_;
|
|
if ($_ == $ARGV[1]) {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
###
|
|
### If no "backup" of this key exists, make one.
|
|
###
|
|
if (!$::HKEY_LOCAL_MACHINE->Open('SOFTWARE\Microsoft\.NETFramework.BAK', $uc)) {
|
|
$::HKEY_LOCAL_MACHINE->Open('SOFTWARE\Microsoft', $ms) unless ($ms);
|
|
$ms->Create('.NETFramework.BAK', $target);
|
|
&BackupKey($urt, $target);
|
|
}
|
|
|
|
if ($urt->QueryValueEx("InstallRoot", $type, $value)) {
|
|
if ($value eq $ARGV[0]) {
|
|
|
|
if ($version != $ARGV[1]) {
|
|
###
|
|
### The InstallRoot matches ours but the version is different, nuke the
|
|
### GAC of things we might have stored there.
|
|
|
|
system("$ENV{'URTINSTALL'}\\gacclean.cmd");
|
|
|
|
exit(0);
|
|
}
|
|
|
|
#
|
|
# InstallRoot matches as does version - we're done.
|
|
#
|
|
|
|
exit(2);
|
|
} else {
|
|
if ($version == $ARGV[1]) {
|
|
#
|
|
# InstallRoot differs, but version matches - assume all is well for now.
|
|
#
|
|
exit (2);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# No record of install or the install path and version doesn't match.
|
|
|
|
exit(0);
|
|
|
|
###
|
|
### Makes a deep copy of a particular reg key.
|
|
###
|
|
sub BackupKey($$)
|
|
{
|
|
my $srckey = shift;
|
|
my $targetkey = shift;
|
|
my ($subskey, $subtkey, @keys, %values);
|
|
|
|
$srckey->GetKeys(\@keys);
|
|
foreach (@keys) {
|
|
$srckey->Open($_, $subskey);
|
|
$targetkey->Create($_, $subtkey);
|
|
BackupKey($subskey, $subtkey);
|
|
}
|
|
|
|
$srckey->GetValues(\%values);
|
|
foreach (keys(%values)) {
|
|
$targetkey->SetValueEx($_, 0, $values{$_}->[1], $values{$_}->[2]);
|
|
}
|
|
}
|
|
|
|
__END__
|