# From the book "Windows Server 2003 Networking Recipes"

# This code configures the Registry blob that enables
# Alternate IP Configuration on a particular NIC.

# Grab the GUID for the appropriate NIC at the command line
# using the following syntax:
# > wmic nicconfig get ipaddress,settingid > \foo.txt
# > for /f "tokens=2" %a in ('type foo.txt ^| findstr "<IP Address>"') do echo %a

# ------ SCRIPT CONFIGURATION ------

use Win32::OLE qw(in);
use Win32::OLE::Variant;

use constant CONNECTED => 2;
use constant HKEY_LOCAL_MACHINE => 0x80000002;

$strTargetGUID = '{01B3816C-AB47-3E53-CB7C-88345293465}';
$strAlternateIP = '192.168.1.151';
$strAlternateMask = '255.255.255.0';
$strAlternateGW = '192.168.1.1';
$strAlternateDNS1 = '192.168.1.120';
$strAlternateDNS2 = '192.168.1.121';

use constant strComputer => '.';

# ------ END CONFIGURATION ---------

$objWMIService = Win32::OLE->GetObject('winmgmts:\\\\.\\root\\cimv2');

$nics = $objWMIService->ExecQuery('SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True');

foreach my $nic (in $nics) {
    $strGUID = $nic->SettingID;

    # only populate the alternate IP information for the correct NIC
    if ($strGUID eq $strTargetGUID) {

        # make sure that DHCP is enabled
        if ($nic->DHCPEnabled == 0) {
            print "Error! DHCP must be enabled for alternate IP configurations to function.\n";

            # now you can get to work
        }
        else {
            # first enable alternate IP configuration for this NIC
            $strPath = 'SYSTEM\\CurrentControlSet\\Services\\' . 'Tcpip\\Parameters\\Interfaces\\' . $strGUID;
            $strValue = 'ActiveConfigurations';
            $strRegValue = 'Alternate_' . $strGUID;
            $arrValues = [$strRegValue];

            $Registry = Win32::OLE->GetObject('winmgmts:{impersonationLevel=impersonate}!\\\\.\\root\\default:StdRegProv');
            $Registry->SetMultiStringValue(HKEY_LOCAL_MACHINE, $strPath, $strValue, $arrValues);

            # now populate the alternate config with the appropriate values
            # the first 20 values of the blob are fixed
            $arrBlobValues->[0] = 0x32;
            $arrBlobValues->[1] = 0x00;
            $arrBlobValues->[2] = 0x00;
            $arrBlobValues->[3] = 0x00;
            $arrBlobValues->[4] = 0x00;
            $arrBlobValues->[5] = 0x00;
            $arrBlobValues->[6] = 0x00;
            $arrBlobValues->[7] = 0x00;
            $arrBlobValues->[8] = 0x04;
            $arrBlobValues->[9] = 0x00;
            $arrBlobValues->[10] = 0x00;
            $arrBlobValues->[11] = 0x00;
            $arrBlobValues->[12] = 0x00;
            $arrBlobValues->[13] = 0x00;
            $arrBlobValues->[14] = 0x00;
            $arrBlobValues->[15] = 0x00;
            $arrBlobValues->[16] = 0xFF;
            $arrBlobValues->[17] = 0xFF;
            $arrBlobValues->[18] = 0xFF;
            $arrBlobValues->[19] = 0x7F;

            # next insert the 4 octets of the IP address into
            # array index 20 – 23
            $arrIP = VBS::Split($strAlternateIP, '.');
            $index = 20;
            foreach my $octet (@{$arrIP}) {
                $arrBlobValues->{$index} = Variant(VT_I4, $octet);
                $index = $index + 1;
            }

            # the next 20 values of the blob are fixed
            $arrBlobValues->[24] = 0x01;
            $arrBlobValues->[25] = 0x00;
            $arrBlobValues->[26] = 0x00;
            $arrBlobValues->[27] = 0x00;
            $arrBlobValues->[28] = 0x00;
            $arrBlobValues->[29] = 0x00;
            $arrBlobValues->[30] = 0x00;
            $arrBlobValues->[31] = 0x00;
            $arrBlobValues->[32] = 0x04;
            $arrBlobValues->[33] = 0x00;
            $arrBlobValues->[34] = 0x00;
            $arrBlobValues->[35] = 0x00;
            $arrBlobValues->[36] = 0x00;
            $arrBlobValues->[37] = 0x00;
            $arrBlobValues->[38] = 0x00;
            $arrBlobValues->[39] = 0x00;
            $arrBlobValues->[40] = 0xFF;
            $arrBlobValues->[41] = 0xFF;
            $arrBlobValues->[42] = 0xFF;
            $arrBlobValues->[43] = 0x7F;

            # now insert the 4 octets of the subnet mask
            # into array index 44 – 47
            $arrIP = VBS::Split($strAlternateMask, '.');
            $index = 44;
            foreach my $octet (@{$arrIP}) {
                $arrBlobValues->{$index} = Variant(VT_I4, $octet);
                $index = $index + 1;
            }

            # now insert another 20 fixed values
            $arrBlobValues->[48] = 0x03;
            $arrBlobValues->[49] = 0x00;
            $arrBlobValues->[50] = 0x00;
            $arrBlobValues->[51] = 0x00;
            $arrBlobValues->[52] = 0x00;
            $arrBlobValues->[53] = 0x00;
            $arrBlobValues->[54] = 0x00;
            $arrBlobValues->[55] = 0x00;
            $arrBlobValues->[56] = 0x04;
            $arrBlobValues->[57] = 0x00;
            $arrBlobValues->[58] = 0x00;
            $arrBlobValues->[59] = 0x00;
            $arrBlobValues->[60] = 0x00;
            $arrBlobValues->[61] = 0x00;
            $arrBlobValues->[62] = 0x00;
            $arrBlobValues->[63] = 0x00;
            $arrBlobValues->[64] = 0xFF;
            $arrBlobValues->[65] = 0xFF;
            $arrBlobValues->[66] = 0xFF;
            $arrBlobValues->[67] = 0x7F;

            # now insert the 4 octets of the default gateway
            # into array index 68 – 71
            $arrIP = VBS::Split($strAlternateGW, '.');
            $index = 68;
            foreach my $octet (@{$arrIP}) {
                $arrBlobValues->{$index} = Variant(VT_I4, $octet);
                $index = $index + 1;
            }

            # 20 more fixed values
            $arrBlobValues->[72] = 0x06;
            $arrBlobValues->[73] = 0x00;
            $arrBlobValues->[74] = 0x00;
            $arrBlobValues->[75] = 0x00;
            $arrBlobValues->[76] = 0x00;
            $arrBlobValues->[77] = 0x00;
            $arrBlobValues->[78] = 0x00;
            $arrBlobValues->[79] = 0x00;
            $arrBlobValues->[80] = 0x08;
            $arrBlobValues->[81] = 0x00;
            $arrBlobValues->[82] = 0x00;
            $arrBlobValues->[83] = 0x00;
            $arrBlobValues->[84] = 0x00;
            $arrBlobValues->[85] = 0x00;
            $arrBlobValues->[86] = 0x00;
            $arrBlobValues->[87] = 0x00;
            $arrBlobValues->[88] = 0xFF;
            $arrBlobValues->[89] = 0xFF;
            $arrBlobValues->[90] = 0xFF;
            $arrBlobValues->[91] = 0x7F;

            # now insert the 4 octets of the primary DNS server
            # into array index 92 – 95
            $arrIP = VBS::Split($strAlternateDNS1, '.');
            $index = 92;
            foreach my $octet (@{$arrIP}) {
                $arrBlobValues->{$index} = Variant(VT_I4, $octet);
                $index = $index + 1;
            }

            # now insert the 4 octets of the secondary DNS server
            # into array index 96 – 99
            $arrIP = VBS::Split($strAlternateDNS2, '.');
            $index = 96;
            foreach my $octet (@{$arrIP}) {
                $arrBlobValues->{$index} = Variant(VT_I4, $octet);
                $index = $index + 1;
            }

            # finally, save this information to the Registry
            $strPath = 'SYSTEM\\ControlSet001\\Services\\Dhcp\\Configurations\\Alternate_' . $strGUID;
            $strValue = 'Options';

            $Registry = Win32::OLE->GetObject('winmgmts:{impersonationLevel=impersonate}!\\\\.\\root\\default:StdRegProv');

            $Return = $Registry->CreateKey(HKEY_LOCAL_MACHINE, $strPath);

            $Return = $Registry->SetBinaryValue(HKEY_LOCAL_MACHINE, $strKeyPath, $strValue, $arrBlobValues);
        }
    }
}
print "Script completed successfully. \n";

package VBS;
use strict;
sub Split {
    my($expression, $delim, $count, $compare) = @_;
    my $re;
    $delim =~ s/\r//g;
    if (!defined $delim || !length($delim)) {
	$re = qr/\s/;
    }
    else {
	$re = $compare ? qr/\Q$delim\E/i : qr/\Q$delim\E/;
    }
    if (!defined $count || $count == -1) {
        return [CORE::split($re, $expression)];
    }
    else {
        return [CORE::split($re, $expression, $count)];
    }
}