#  GetIP.pl
#  Example 3.16:
#  ----------------------------------------
#  From "Win32 Perl Scripting: Administrators Handbook" by Dave Roth
#  Published by New Riders Publishing.
#  ISBN # 1-57870-215-1
#
#  This script will retrieve all IP Addresses that are bound
#  to network devices on a specified machine. This includes IPs that are
#  bound to any NIC (network card, RAS dail up, etc).
#  If a particular NIC specifies 0.0.0.0 (typically to indicate that the
#  NIC will request an IP via DHCP, PPP, etc) it will be ignored.
#  ALL IPs are discovered even on cards that are disabled.
#
print "From the book 'Win32 Perl Scripting: The Administrator's Handbook' by Dave Roth\n\n";


use Win32::Registry;

%KeyName = (
  serviceroot         =>  'System\CurrentControlSet\Services',
  tcplink             =>  'Tcpip\Linkage',
  tcplink_disabled    =>  'Tcpip\Linkage\Disabled',
  win2k_tcplink       =>  'Tcpip\Parameters\Interfaces',
  deviceparam_tcp     =>  'Parameters\Tcpip',
);

$Root = $HKEY_LOCAL_MACHINE;

if( $Machine = $ARGV[0] )
{
  $HKEY_LOCAL_MACHINE->Connect( $Machine, $Root ) 
      || die "Could not connect to the registry on '$Machine'\n";
}

if( $Root->Open( $KeyName{serviceroot}, $ServiceRoot ) )
{
  # First check if this is Win2k...
  if( $ServiceRoot->Open( $KeyName{win2k_tcplink}, $Links ) )
  {
    my @Interfaces;
    if( $Links->GetKeys( \@Interfaces ) )
    {
      foreach my $DeviceName ( @Interfaces ) 
      {
        push( @Devices, [
                          "$KeyName{win2k_tcplink}\\$DeviceName",
                          $DeviceName
                        ] );
      }
    }
    $Links->Close();
  }
  # Get the device names of the cards tcp is bound to...
  else
  {
    if( $ServiceRoot->Open( $KeyName{tcplink}, $Links ) )
    {
      my( $Data );
      if( $Links->QueryValueEx( "Bind", $DataType, $Data ) )
      {
        $Data =~ s/\n/ /gs;
        $Data =~ s/\\Device\\//gis;
        $Data =~ s/^\s+(.*)\s+$/$1/gs;
        foreach my $DeviceName ( split( /\c@+/, $Data ) )
        {
          push( @Devices, 
                [
                  "$DeviceName\\$KeyName{deviceparam_tcp}",
                  $DeviceName
                ] );
        }
      }
      $Links->Close();
    }
    # Get the device names of cards that tcp is bound to but disabled...
    if( $ServiceRoot->Open( $KeyName{tcplink_disabled}, $Links ) )
    {
      my( $Data );
    
      if( $Links->QueryValueEx( "Bind", $DataType, $Data ) )
      {
        $Data =~ s/\s+//gs;
        $Data =~ s/\\Device\\//gis;
        foreach my $DeviceName ( split( /\c@+/, $Data ) )
        {
          push( @Devices, 
                [ 
                  "$DeviceName\\$KeyName{deviceparam_tcp}",
                  $DeviceName
                ] );
        }
      }
      $Links->Close();
    }
  }
  
  foreach my $Device ( @Devices )
  {
    my( $DeviceTCPKey );
    my( $Path ) = $Device->[0];
    my( $DeviceName ) = $Device->[1];
    
    if( $ServiceRoot->Open( $Path, $DeviceTCPKey ) )
    {
      my %Hash;
      my( @IP, @Subnet, @Gateway, @DHCP, @DNS );
      my( $Data, $DataType, $Domain );
    
      # Get the domain...
      $DeviceTCPKey->QueryValueEx( "Domain", $DataType, $Domain );
      
      # Get the IP addresses...
      if( $DeviceTCPKey->QueryValueEx( "IPAddress", 
                                       $DataType, 
                                       $Data ) )
      {
        $Data =~ s/\s+//g;
        $Data =~ s/0\.0\.0\.0//g;
        $Data =~ s/\c@+/\c@/g;
        push( @IP, split( /\c@/, $Data ) );
        push( @DHCP, ( "no" ) x scalar split( /\c@/, $Data ) );
      }
    
      # Get the Subnet masks...
      if( $DeviceTCPKey->QueryValueEx( "SubnetMask", 
                                       $DataType, 
                                       $Data ) )
      {
        $Data =~ s/\s+//g;
        $Data =~ s/0\.0\.0\.0//g;
        $Data =~ s/\c@+/\c@/g;
        push( @Subnet, split( /\c@/, $Data ) );
      }
			# Get the default gateways...
			if( $DeviceTCPKey->QueryValueEx( "DefaultGateway", 
                                       $DataType, 
                                       $Data ) )
			{
			    $Data =~ s/\s+//g;
			    $Data =~ s/0\.0\.0\.0//g;
			    $Data =~ s/\c@+/\c@/g;
			    push( @Gateway, split( /\c@/, $Data ) );
			}
      # Get the name servers...
      if( $DeviceTCPKey->QueryValueEx( "NameServer", 
                                       $DataType, 
                                       $Data ) )
      {
        $Data =~ s/0\.0\.0\.0//g;
        push( @DNS, split( /\s+/, $Data ) );
      }

      # Query DHCP stats
      if( $DeviceTCPKey->QueryValueEx( "EnableDHCP", 
                                       $DataType, 
                                       $Data ) )
      {
        $Hash{dhcp} = (( $Data )? "yes":"no" );

         # Get the DHCP domain...
        $DeviceTCPKey->QueryValueEx( "DhcpDomain", 
                                     $DataType, 
                                     $Domain );

        # Get the DHCP IP Addresses...
        if( $DeviceTCPKey->QueryValueEx( "DHCPIPAddress", 
                                         $DataType, 
                                         $Data ) )
        {
          $Data =~ s/\s+//g;
          $Data =~ s/0\.0\.0\.0//g;
          $Data =~ s/\c@+/\c@/g;
          push( @IP, split( /\c@/, $Data ) );
          push( @DHCP, ( "yes" ) x scalar split( /\c@/, $Data ) );
        }
                
        # Get the DHCP subnet masks...
        if( $DeviceTCPKey->QueryValueEx( "DHCPSubnetMask", 
                                         $DataType, 
                                         $Data ) )
        {
          $Data =~ s/\s+//g;
          $Data =~ s/0\.0\.0\.0//g;
          $Data =~ s/\c@+/\c@/g;
          push( @Subnet, split( /\c@/, $Data ) );
        }
        
        # Get the DHCP gateways...
        if( $DeviceTCPKey->QueryValueEx( "DHCPDefaultGateway", 
                                         $DataType, 
                                         $Data ) )
        {
          $Data =~ s/\s+//g;
          $Data =~ s/0\.0\.0\.0//g;
          $Data =~ s/\c@+/\c@/g;
          push( @Gateway, split( /\c@/, $Data ) );
        }
         
        # Get the DHCP name servers...
        if( $DeviceTCPKey->QueryValueEx( "DHCPNameServer", 
                                         $DataType, 
                                         $Data ) )
        {
          $Data =~ s/0\.0\.0\.0//g;
          push( @DNS, split( /\s+/, $Data ) );
        }
      }
      next if( 0 == scalar @IP );
      $Hash{name} = $DeviceName;
      $Hash{ip} = join( " " x 8, @IP );
      $Hash{subnet} = join( " " x 8, @Subnet );
      $Hash{gateway} = join( " " x 8, @Gateway );
      $Hash{dhcp} = join( " " x 8, @DHCP );
      $Hash{dns} = join( " " x 8, @DNS );
      $Hash{domain} = $Domain;
  
      # Push our newfound data onto the stack...
      push( @TCPConfig, \%Hash );
      
      $DeviceTCPKey->Close();    
    }
  }
  print "The machine $Machine has the following IP addresses:\n";
  foreach $IP ( @TCPConfig )
  {
    print "\nInterface: $IP->{name}\n";
    print "Domain: $IP->{domain}\n";
  
    $~ = TCPHeader;
    write;
    $~ = TCPDump;
    write;
  }
  $ServiceRoot->Close();
}

format TCPHeader =
  @<<< @<<<<<<<<<<<<<< @<<<<<<<<<<<<<< @<<<<<<<<<<<<<< @<<<<<<<<<<<<<<
  "DHCP", "IP Address", "Subnet Mask", "Gateway", "DNS"
  ---- --------------- --------------- --------------- ---------------
.

format TCPDump =
  ^<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<
  $IP->{dhcp}, $IP->{ip}, $IP->{subnet}, $IP->{gateway}, $IP->{dns}
~ ^<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<
  $IP->{dhcp}, $IP->{ip}, $IP->{subnet}, $IP->{gateway}, $IP->{dns}
~ ^<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<
  $IP->{dhcp}, $IP->{ip}, $IP->{subnet}, $IP->{gateway}, $IP->{dns}
~ ^<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<
  $IP->{dhcp}, $IP->{ip}, $IP->{subnet}, $IP->{gateway}, $IP->{dns}
~ ^<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<
  $IP->{dhcp}, $IP->{ip}, $IP->{subnet}, $IP->{gateway}, $IP->{dns}
~ ^<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<
  $IP->{dhcp}, $IP->{ip}, $IP->{subnet}, $IP->{gateway}, $IP->{dns}
~ ^<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<
  $IP->{dhcp}, $IP->{ip}, $IP->{subnet}, $IP->{gateway}, $IP->{dns}
~ ^<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<
  $IP->{dhcp}, $IP->{ip}, $IP->{subnet}, $IP->{gateway}, $IP->{dns}
.