use Net::hostent;
use Net::Ping;
use Socket;
use Win32;
use Win32::TieRegistry (Delimiter=>"/", ArrayValues=>0,
  qw(REG_DWORD REG_SZ REG_MULTI_SZ));

use constant TRUE     => 1;
use constant FALSE     => 0;

my($p) = Net::Ping->new("icmp");

# Identify OS directories

$Etc = Win32::ExpandEnvironmentStrings("%SystemRoot%/System32/Drivers/
+Etc");
chmod(0666,"$Etc/Lmhosts") || print "failed to make $Etc/Lmhosts write
+able\n";

my($lmhOrig)="c:/tmp/lmhosts";
my($myname)=uc(Win32::NodeName());
my($timeout) = 6;
my($timestep) = 0.1;

my(%ip,%pl,$myip,$mynm);
open(LMH,"$lmhOrig")||die("Unable to open $lmhOrig\n");
foreach (<LMH>) {
  chop;
#  print "LMH: $_\n";
  if ( /(\d+\.\d+\.\d+\.\d+)\s+([\da-z]+)\s(.*)?/i ) {
    
    my($cip)   = $1;
    my($cname) = uc($2);
    my($preld) = $3;
    $preld =~ s/^\s+//;
    #printf "** %-20s %-20s %s\n",$cip,$cname,$preld;
    $ip{$cname}=$cip;  # Array of network addresses indexed by compute
+r name
    $pl{$cname}=$preld;
    if ( $cname eq $myname ) {
      $myip = $cip;
    }
  }
}
close LMH;

unless ($myip) {
  unless ($h = gethost($me)) {
    warn "$0: no such host: $me\n";
    exit;
  }
  if ( @{$h->addr_list} > 1 ) {
    printf "\taddress is [%s]\n", inet_ntoa($h->addr);
    $myip = inet_ntoa($h->addr);
    warn "$0 - this computer has multiple addresses - using $myip\n";
    } else {
    $myip = inet_ntoa($h->addr);
  }
}

print "\nComputer Name  : $myname\n";
print "Network Address: $myip\n\n";

# Identify local host address and netmask
unless ($h = gethost($myname)) {
  warn "$0: no such host: $myname\n";
  exit;
}

# Open registry

$NetBTKey = $Registry->{"//" . $me . "/LMachine/SYSTEM/CurrentControlS
+et/Services/NetBT/"} ||
die "\n  Failed to connect to registry on $me\n\n";

$SvcKey = $Registry->{"//" . $me . "/LMachine/SYSTEM/CurrentControlSet
+/Services/"} ||
die "\n  Failed to connect to registry on $me\n\n";


# *********************************************
# Get network adapters
# *********************************************
@Adapters = grep(!/^Ndis/i, keys %{$NetBTKey->{"Adapters/"}});
$AdapterCount = @Adapters;
# Sort adapters by Bind order
foreach $ServiceName (split(/\000/, $NetBindKey->{"Tcpip/Linkage/Bind"
+})) {
  $ServiceName =~ s/^\\device\\NetBT_//i;
  push(@AdaptersByBind, $ServiceName) if grep { /^$ServiceName\/$/ } @
+Adapters;
}
# Add non-bound adapters
foreach $ServiceName (@Adapters) {
  $ServiceName =~ s/\/$//;  # Remove trailing '/'s
  push(@AdaptersByBind, $ServiceName) if !grep { /^$ServiceName$/ } @A
+daptersByBind;
}

print "Network Adapters Identified   : @Adapters\n";
print "Network Adapters In Bind Order: @AdaptersByBind\n\n";

foreach $ServiceName (@AdaptersByBind) {

  #print "Adapter: $ServiceName\n";
  $NetBTaKey = "Adapters/" . $ServiceName . "/";
  $iFaceKey  = $ServiceName . "/Parameters/TCPIP/";
  $pEnableDHCP = hex($SvcKey->{$iFaceKey . "EnableDHCP"});
  print "EnableDHCP: $pEnableDHCP\n";
  if (! $pEnableDHCP) {
    $pIPAddress  = $SvcKey->{$iFaceKey  . "IPAddress"       };
    $pSubnetMask = $SvcKey->{$iFaceKey  . "SubnetMask"      };
    $pGateway    = $SvcKey->{$iFaceKey  . "DefaultGateway"  };
    $pWserverA   = $NetBTKey->{$NetBTaKey . "NameServer"      };
    $pWserverB   = $NetBTKey->{$NetBTaKey . "NameServerBackup"};
  }else{
    $pIPAddress  = $SvcKey->{$iFaceKey . "DhcpIPAddress"} ?         $S
+vcKey->{$iFaceKey . "DhcpIPAddress"} : "";
    $pSubnetMask = $SvcKey->{$iFaceKey . "DhcpSubnetMask"} ?        $S
+vcKey->{$iFaceKey . "DhcpSubnetMask"} : "";
    $pGateway    = $SvcKey->{$iFaceKey . "DhcpDefaultGateway"} ?    $S
+vcKey->{$iFaceKey . "DhcpDefaultGateway"} : "";
    $pWserverA   = $NetBTKey->{$NetBTaKey . "DhcpNameServer"} ?       
+$NetBTKey->{$NetBTaKey . "DhcpNameServer"} : "";
    $pWserverB   = $NetBTKey->{$NetBTaKey . "DhcpNameServerBackup"} ? 
+$NetBTKey->{$NetBTaKey . "DhcpNameServerBackup"} : "";
  }

  $pIPAddress  =~ s/([\.0-9]+)/$1/;
  if ($pIPAddress =~ /$myip/) {
    $mynm = $pSubnetMask;
    $mygw = $pGateway;
    $DNShostname   = $SvcKey->{"Tcpip/Parameters/Hostname"};
    $DNSdomain     = $SvcKey->{"Tcpip/Parameters/Domain"};
    $DNSnamservers = $SvcKey->{"Tcpip/Parameters/NameServer"};
    $DNSsearchlist = $SvcKey->{"Tcpip/Parameters/SearchList"};
    $WINSusedns    = hex($NetBTKey->{"Parameters/EnableDNS"});
    $WINSuselmhosts= hex($NetBTKey->{"Parameters/EnableLMHOSTS"});
    print " ********************************************\n";
    print " Adapter Selected:  $ServiceName\n";
    if ( $SvcKey->{"Tcpip/Linkage/Bind"} =~ /$ServiceName/i ) {
      print " ********************************************\n";
      print "   TCPIP EnableDHCP          = $pEnableDHCP\n";
      print "   TCPIP IPAddress           = $pIPAddress\n";
      print "   TCPIP SubnetMask          = $pSubnetMask\n";
      print "   TCPIP DefaultGateway      = $pGateway\n";
      print "\n";
      print "   DNS Hostname              = $DNShostname\n";
      print "   DNS Domain                = $DNSdomain\n";
      print "   DNS NameServer            = $DNSnameservers\n";
      print "   DNS SearchList            = $DNSsearchlist\n";
      print "\n";
      print "   WINS NameServer           = $pWserverA\n";
      print "   WINS NameServerBackup     = $pWserverB\n";
      print "   WINS EnableDNS            = $WINSusedns\n";
      print "   WINS EnableLMHOSTS        = $WINSuselmhosts\n";
      print " ********************************************\n";
      }else{
      print "Disabled in BIND\n";
    }
  }
}
#  Find the network number from local ip and netmask
my($ipa,$ipb,$ipc,$ipd) = split(/\./,$myip);
my $ip32 = ($ipa << 24) + ($ipb << 16) + ($ipc << 8) + $ipd;
my($nma,$nmb,$nmc,$nmd) = split(/\./,$mynm);
my $nm32 = ($nma << 24) + ($nmb << 16) + ($nmc << 8) + $nmd;
$mynw = ($ip32 & $nm32);
$MyNw = ($mynw & 0xFF);
$mynw=$mynw >> 8;
$MyNw = ($mynw & 0xFF) . '.' . $MyNw;
$mynw=$mynw >> 8;
$MyNw = ($mynw & 0xFF) . '.' . $MyNw;
$mynw=$mynw >> 8;
$MyNw = ($mynw & 0xFF) . '.' . $MyNw;

print "\nNetwork Address: $MyNw\n";
print "        Netmask: $mynm\n\n";

# Verify local default gateway is reachable within 3 seconds

unless ( $p->ping($mygw,3)){
  print "Local gateway $mygw is unreachable - quitting\n";
  exit;
}

my(@lm,@un); # Init output arrays
push (@lm,"# Local hosts");
# Put all hosts in local network first in the new lmhosts file
while (($name,$ip)=each %ip) {
  push (@lm,sprintf "%-15s %-12s %s",$ip{$name},$name,$pl{$name})
    if ( CheckIPSubnet($ip,$MyNw,$mynm) );
}

# Find unreachable hosts - and don't test again (makes iterative proce
+ss faster)
print "Identifying any unreachable hosts\n";
push (@un,"#");
push (@un,"# Hosts with a response over $timeout seconds");
while (($name,$ip)=each %ip) {
  next if ( grep {/$name/} @lm);  # Ignore any local hosts (alive or n
+ot)
  print "Testing $name ($ip)\n";
  push (@un,sprintf "%-15s %-12s %s",$ip{$name},$name,$pl{$name}) unle
+ss ( $p->ping($ip,$timeout) );
}

# Determine hosts in order of response time
for($t=$timestep;$t<=$timeout;$t+=$timestep) {
  print "# Testing network response with $t secs\n";
  my($no)=0;
  while (($name,$ip)=each %ip) {
    next if ( grep {/$name/} @lm);  # Ignore if host is already in the
+ new lmhosts file (@lm)
    next if ( grep {/$name/} @un);  # Ignore if host is already in the
+ unreachable lmhosts file (@un)
    print "Testing $name ($ip)\n";
    if ( $p->ping($ip,$t)) {
      push (@lm,"#") if ($no == 0);
      push (@lm,sprintf "# Hosts with a response under %.1f seconds",$
+t) if ($no == 0);
      push (@lm,sprintf "%-15s %-12s %s",$ip{$name},$name,$pl{$name});
      $no++;
    }
  }
}

push (@lm,@un); # Add unreachable lmhosts to end of new lmhosts file
      
open (LMH,">$Etc/Lmhosts")||die "Failed to open $Etc/Lmhosts for writi
+ng\n";
foreach (@lm){
  print "$_\n";
  print LMH "$_\n";
}
close LMH;
      
exit;
#*********************************************************************
+****************************
# CheckIPSubnet - Check if IP address is within entity subnet range
#*********************************************************************
+****************************
      sub CheckIPSubnet($$$) {
        my($ip, $nw, $sn)       = @_;
        my($ipa,$ipb,$ipc,$ipd) = split(/\./,$ip);
        my $ip32 = ($ipa << 24) + ($ipb << 16) + ($ipc << 8) + $ipd;
        my ($sn32);
        if ( $sn =~ /\d+\.\d+\.\d+\.\d+/ ) {
          my($sna,$snb,$snc,$snd) = split(/\./,$sn);
          $sn32 = ($sna << 24) + ($snb << 16) + ($snc << 8) + $snd;
          }elsif ( $sn =~ /^\d+$/ ) {
          $sn32=0;
          for($i=0;$i<$sn;$i++) {
            $sn32 = $sn32 | 1;
            $sn32 = $sn32 << 1;
          }
          $sn32 = $sn32 << (31-$sn);
        }
        my($nwa,$nwb,$nwc,$nwd) = split(/\./,$nw);
        my $nb32 = ($nwa << 24) + ($nwb << 16) + ($nwc << 8) + $nwd;
        my $nt32 = $nb32 | ($sn32 ^ "11111111111111111111111111111111"
+);
        return TRUE if (($ip32 > $nb32) && ($nt32 gt $ip32));
        return FALSE;
      }