#!/Perl
#   GetIP.pl
#   --------
#   This 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.
#
#   Syntax:
#       perl GetIP.pl [Machine Name]
#
#   Examples:
#       perl GetIP.pl
#       perl GetIP.pl \\server
#
#   1999.03.09  roth
#
#   Permission is granted to redistribute and modify this code as long as 
#   the below copyright is included.
#
#   Copyright © 1999 by Dave Roth
#   Courtesty of Roth Consulting
#   http://www.roth.net/

use Win32::Registry;

%KeyName = (
    serviceroot         =>  'System\CurrentControlSet\Services',
    tcplink             =>  'Tcpip\Linkage',
    tcplink_disabled    =>  'Tcpip\Linkage\Disabled',
    tcpparam            =>  'Tcpip\Parameters',
    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 ) )
{
    # Get the device names of the cards tcp is bound to...
    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;
            push( @Devices, ( split( /\c@/, $Data ) ) );
        }
        $Links->Close();
    }

	print "So far got ".scalar @Devices . " using $KeyName{tcplink} ...\n";

    # 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;
            push( @Devices, ( split( /\c@/, $Data ) ) );
        }
        $Links->Close();
    }
    
	print "So far got ".scalar @Devices . " using $KeyName{tcplink_disabled} ...\n";

    foreach $DeviceName ( @Devices )
    {
        my( $DeviceTCPKey );
        if( $ServiceRoot->Open( "$DeviceName\\$KeyName{deviceparam_tcp}", $DeviceTCPKey ) )
        {
            my( @CardIPs, @CardSubNets );
            my( $Data, $iCount, $IPAddress );

            # Get the IP addresses...
            if( $DeviceTCPKey->QueryValueEx( "IPAddress", $DataType, $Data ) )
            {
                $Data =~ s/\s+//gm;
                push( @CardIPs, ( split( /\c@/, $Data ) ) );
            }

            # Get the Subnet masks...
            if( $DeviceTCPKey->QueryValueEx( "SubnetMask", $DataType, $Data ) )
            {
                $Data =~ s/\s+//gm;
                push( @CardSubNets, ( split( /\c@/, $Data ) ) );
            }

			print "On $DeviceName\\$KeyName{deviceparam_tcp} -\n";
			print "got " . scalar @CardIPs . " CardIPs ...\n";
			print "and " . scalar @CardSubNets . " CardSubNets ...\n";
            
            # Push our new found data onto the stack...
            $iCount = 0;
            map
            {
                my( %Hash );
                # We don't want 0.0.0.0 since it means the IP will be procured via DHCP or something...
                if ($_ eq '0.0.0.0') {
					print "Discarding blank 0.0.0.0 ...\n";
					next;
                }
                # next if( $_ eq '0.0.0.0' );

                $Hash{ip} = $_;
                $Hash{subnet} = $CardSubNets[$iCount];
                push( @IP, \%Hash );
                $iCount++;
            } ( @CardIPs );

            $DeviceTCPKey->Close();    
        } else {
			print "Unable to open $DeviceName\\$KeyName{deviceparam_tcp} ...\n";
		}
    }

    print "This machine $Machine has the following ". scalar @IP . " IP addresses:\n";

    foreach $IPStruct ( @IP )
    {
        print "\t$IPStruct->{ip} \t(subnet: $IPStruct->{subnet})\n";
    }

    $ServiceRoot->Close();
}

### eof - GetIP.pl

