use warnings; use strict; use Win32::NetAdmin qw(GetServers SV_TYPE_ALL ); use Win32::TieRegistry qw(KEY_READ); use Data::Dumper; use Fcntl; my %bad_stuff = ( KaZaA => qr/kazaa/i, Gnucleus => qr/gnucleus/i, Napster => qr/napster/i, #Most of these are guesswork, BearShare => qr/bearshare/i, #pulled from http://www.gnutelliums.com/ LimeWire => qr/limewire/i, Morpheus => qr/morpheus/i, Phex => qr/phex/i, Swapper => qr/swapper/i, XoloX => qr/xolox/i, eDonkey => qr/edonkey/i, BitTorrent => qr/bittorrent/i, iMesh => qr/imesh/i, "Comet Systems" => qr/comet\s*systems/i, "Gator.com" => qr/gator/i, ); $Registry->Delimiter("/"); my $domain; ($domain = Win32::DomainName) or die "Unable to obtain the domain name"; my %machines; my %installed_software; GetServers("", $domain, SV_TYPE_ALL, \%machines) or die "GetServers failed: $!\n"; foreach my $machine (sort keys %machines) { #print "Attempting to connect to registry on $machine\n"; my $remKey= $Registry->Connect($machine, "HKEY_USERS/", { Access=>KEY_READ, Delimiter=>"/" } ); unless($remKey) { warn "Couldn't connect to $machine: $^E\n"; next; } foreach my $user_sid ($remKey->SubKeyNames) { next if($user_sid =~ /_classes$/i); #There's always a sid....._classes key - skip it. my $user_key = $Registry->Connect($machine, "HKEY_USERS/$user_sid/SOFTWARE/", { Access=>KEY_READ, Delimiter=>"/" } ); unless($user_key) { warn "Couldn't get a software key for sid $user_sid on machine $machine\n"; next; } my $software_key = $Registry->Connect($machine, "HKEY_LOCAL_MACHINE/SOFTWARE/", { Access=>KEY_READ, Delimiter=>"/" } ); unless($software_key) { warn "Couldn't get a software key from HKEY_LOCAL_MACHINE on machine $machine\n"; next; } foreach my $subkey ($user_key->SubKeyNames, $software_key->SubKeyNames) { foreach my $software (keys %bad_stuff) { if($subkey =~ $bad_stuff{$software}) { next if($installed_software{$machine.$software}++); print "Machine $machine could have $software installed\n"; } } } } }