Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Ce site au démarrage

begin process at 2012 02 17 02:38:32

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

Réseau & Internet

> CONFIGURATION IP ALTERNATIVE AVEC DHCP ACTIF (ALTERNATE IP)

CONFIGURATION IP ALTERNATIVE AVEC DHCP ACTIF (ALTERNATE IP)

Information sur la source

Attention: ce code a été marqué comme suspect par un admin, il peut donc être dangereux. Ce code a été laissé sur le site dans un but pédagogique, ne l'exécutez pas si vous ne comprenez pas son contenu!

Note :

10,00 / 10

Catégorie :Réseau & Internet Classé sous :configuration, ip, alternative, alternate, vbs Niveau :Initié Date de création :09/02/2007 Date de mise à jour :18/12/2008 22:36:31 Vu :11 926

Auteur : burster42

Ecrire un message privé

Commentaire sur cette source (5)

Ajouter un commentaire et/ou une note

Description

Note: Pour que ce script fonctionne:
-Il faudra avoir désactivé APIPA
-Etre dans le cas d'une configuration IP statique.
-Avoir une carte réseau (vaut mieux non?) nommé "Local Area Connection" ou "Connexion au réseau local"

But:
Sur l'interface réseau...
-Dupliquera la configuration IP statique en cours vers la configuration IP alternative (2ième onglet)
-Activera le DHCP sur cette interface

Pour quoi faire?
Certaines applications exigent une configuration IP en DHCP or l'architecture de votre réseau ne le permet pas (pas de présence de serveur DHCP dans votre entreprise), la configuration IP alternative constitue une solution à cette problématique. Il ne faut pas oublier de désactiver l'APIPA!
Il est à noter aussi que pour le faire par script, Microsoft documente très mal (pas du tout ?) cette partie.

Le code:
-Les vérifications sont ici basiques.
-Seul 2 serveurs DNS et WINS seront sauvegardés aux maximums.
-Il faudra bien évidemment rebooter.

Source

Option explicit
'On error resume next
'Script permettant d'activer la configuration alternative IP
'Pour cela on recupere d'abord la clé SID dans le registre correspondant a la bonne interface
'en faisant une comparaison avec les données (pour la trouver)
'après quoi on y rajoute des clés de registre et on active le dhcp.
Dim strComputer
Dim objWMIService
Dim colAdapters
Dim objAdapter
Dim sIP
Dim sMask
Dim sGateway
'On recupere IP + Mask + Passerelle
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\"& strComputer & "\root\cimv2")
Set colAdapters = objWMIService.ExecQuery ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each objAdapter in colAdapters
sIP = objAdapter.IPAddress(0)
sMask = objAdapter.IPSubnet(0)
sGateway = objAdapter.DefaultIPGateway(0)
Exit For
Next
'On va chercher dans le registre l'interface correspondante
Dim objReg
Dim strKeyPath
Dim subkey
Dim arrSubkeys
Dim arrValueTypes
Dim arrValueNames
Dim arrStrValue
Dim mySID
Dim strValue
Dim Returned
const REG_SZ = 1
const REG_EXPAND_SZ = 2
const REG_BINARY = 3
const REG_DWORD = 4
const REG_MULTI_SZ = 7
const HKEY_LOCAL_MACHINE = &H80000002
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\"& strComputer & "\root\default:StdRegProv")
strKeyPath = "SYSTEM\CurrentControlSet\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}"
objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
'On cherche la clé de la bonne interface
mySID = ""
strValue = ""
For Each subkey In arrSubKeys
'On exclut la clé Descriptions et on regarde toutes les autres clés SID
If (subkey <> "Descriptions") then
Returned = objReg.GetStringValue(HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey & "\Connection", "Name", strValue)
If (strValue = "Local Area Connection") OR (strValue = "Connexion au réseau local") then
mySID = subkey
Exit For
End if
End if
Next
'mySID contient la clé SID de la bonne interface carte reseau local
'Pour rappel on a déjà l'ip, le mask et la passerelle de l'interface
'sIP et sMask et sGateway
'Maintenant il nous faut le wins (si existant) et les serveurs DNS
'Pour le dns: HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\{491CBE6B-84AD-408C-8DC3-A041326646E6}
'Pour le WINS : HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\NetBT\Parameters\Interfaces\Tcpip_{491CBE6B-84AD-408C-8DC3-A041326646E6}
'NameServerList (REG_MULTI_SZ) => wins
'NameServer (REG_SZ) => DNS
strValue = ""
strKeyPath = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces"
Returned = objReg.GetStringValue(HKEY_LOCAL_MACHINE, strKeyPath & "\" & mySID, "NameServer", strValue)
Dim arrDNS, arrWINS
arrDNS = Split(strValue, ",")
strKeyPath = "SYSTEM\CurrentControlSet\Services\NetBT\Parameters\Interfaces\Tcpip_"
Returned = objReg.GetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath & mySID, "NameServerList", arrWINS)
'Les WINS sont retournes de base dans un tableau, on va donc voir le nombre de WINS inséré dans le tableau et les concaténer dans une chaine de caractere
If (UBound(arrWINS) >= 0) then
If (UBound(arrWINS) = 0) then sWINS = arrWINS(0)
If (UBound(arrWINS) = 1) then sWINS = arrWINS(0) & "," & arrWINS(1)
End if
Returned = objReg.SetStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "WINS", sWINS)
'Creation de la valeur ActiveConfigurations pour activer la configuration alternative
arrStrValue = ""
strKeyPath = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\" & mySID
arrStrValue = Array("Alternate_" & mySID)
Returned = objReg.SetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "ActiveConfigurations", arrStrValue)
'Activation DHCP
Returned = objReg.SetDWORDValue(HKEY_LOCAL_MACHINE, strKeyPath, "EnableDHCP", 1)
'Vidage des champs sur le premier onglet de la configuration IP
Returned = objReg.SetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "DefaultGateway", Array())
Returned = objReg.SetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "DefaultGatewayMetric", Array())
Returned = objReg.SetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "IPAddress", Array())
Returned = objReg.SetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "SubnetMask", Array())
Returned = objReg.SetStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "NameServer", "")
Dim myvalueWINS, myvalueDNS
'On vérifie qu'on a bien des WINS
myvalueWINS = 0
myvalueDNS = &H04
If (UBound(arrWINS) >= 0) then
If (UBound(arrWINS) = 0) then myvalueWINS = &H04
If (UBound(arrWINS) = 1) then myvalueWINS = &H08
End if
If (UBound(arrDNS) >= 0) then
If (UBound(arrDNS) = 0) then myvalueDNS = &H04
If (UBound(arrDNS) = 1) then myvalueDNS = &H08
End if
'Maintenant il reste plus qu'à basculer toutes les informations IP, MASK, GATEWAY, DNS, WINS dans la configuration alternative
'Le format des IP est special: les 20 premières valeures sont fixes.
'Tableau de 95 quand 1 DNS
'Tableau de 99 quand 2 DNS
'Tableau de 127 quand 2 dns et 2 wins
'Tableau de 123 qunad 2 dns et 1 wins
'Tableau de 99 quand 1 dns et 1 wins
Dim arrBlobValues()
If (myvalueDNS = &H04 AND myvalueWINS = 0) then
ReDim arrBlobValues(95)
elseif (myvalueDNS = &H04 AND myvalueWINS = &H04) then
ReDim arrBlobValues(119)
elseif (myvalueDNS = &H04 AND myvalueWINS = &H08) then
ReDim arrBlobValues(123)
elseif (myvalueDNS = &H08 AND myvalueWINS = 0) then
ReDim arrBlobValues(99)
elseif (myvalueDNS = &H08 AND myvalueWINS = &H04) then
ReDim arrBlobValues(123)
elseif (myvalueDNS = &H08 AND myvalueWINS = &H08) then
ReDim arrBlobValues(127)
end if
arrBlobValues(0) = &H32
arrBlobValues(1) = &H00
arrBlobValues(2) = &H00
arrBlobValues(3) = &H00
arrBlobValues(4) = &H00
arrBlobValues(5) = &H00
arrBlobValues(6) = &H00
arrBlobValues(7) = &H00
arrBlobValues(8) = &H04
arrBlobValues(9) = &H00
arrBlobValues(10) = &H00
arrBlobValues(11) = &H00
arrBlobValues(12) = &H00
arrBlobValues(13) = &H00
arrBlobValues(14) = &H00
arrBlobValues(15) = &H00
arrBlobValues(16) = &HFF
arrBlobValues(17) = &HFF
arrBlobValues(18) = &HFF
arrBlobValues(19) = &H7F
'On insère les 4 octets de données correspondant à l'IP dans le tableau d'index soit 20 - 23
Dim arrIP
Dim octet
Dim index
arrIP = Split(sIP, ".")
index = 20
For Each octet in arrIP
arrBlobValues(index) = CInt(octet)
index = index + 1
Next
arrBlobValues(24) = &H01
arrBlobValues(25) = &H00
arrBlobValues(26) = &H00
arrBlobValues(27) = &H00
arrBlobValues(28) = &H00
arrBlobValues(29) = &H00
arrBlobValues(30) = &H00
arrBlobValues(31) = &H00
arrBlobValues(32) = &H04
arrBlobValues(33) = &H00
arrBlobValues(34) = &H00
arrBlobValues(35) = &H00
arrBlobValues(36) = &H00
arrBlobValues(37) = &H00
arrBlobValues(38) = &H00
arrBlobValues(39) = &H00
arrBlobValues(40) = &HFF
arrBlobValues(41) = &HFF
arrBlobValues(42) = &HFF
arrBlobValues(43) = &H7F
arrIP = Split(sMask, ".")
index = 44
For Each octet in arrIP
arrBlobValues(index) = CInt(octet)
index = index + 1
Next
arrBlobValues(48) = &H03
arrBlobValues(49) = &H00
arrBlobValues(50) = &H00
arrBlobValues(51) = &H00
arrBlobValues(52) = &H00
arrBlobValues(53) = &H00
arrBlobValues(54) = &H00
arrBlobValues(55) = &H00
arrBlobValues(56) = &H04
arrBlobValues(57) = &H00
arrBlobValues(58) = &H00
arrBlobValues(59) = &H00
arrBlobValues(60) = &H00
arrBlobValues(61) = &H00
arrBlobValues(62) = &H00
arrBlobValues(63) = &H00
arrBlobValues(64) = &HFF
arrBlobValues(65) = &HFF
arrBlobValues(66) = &HFF
arrBlobValues(67) = &H7F
arrIP = Split(sGateway, ".")
index = 68
For Each octet in arrIP
arrBlobValues(index) = CInt(octet)
index = index + 1
Next
arrBlobValues(72) = &H06
arrBlobValues(73) = &H00
arrBlobValues(74) = &H00
arrBlobValues(75) = &H00
arrBlobValues(76) = &H00
arrBlobValues(77) = &H00
arrBlobValues(78) = &H00
arrBlobValues(79) = &H00
arrBlobValues(80) = myvalueDNS
arrBlobValues(81) = &H00
arrBlobValues(82) = &H00
arrBlobValues(83) = &H00
arrBlobValues(84) = &H00
arrBlobValues(85) = &H00
arrBlobValues(86) = &H00
arrBlobValues(87) = &H00
arrBlobValues(88) = &HFF
arrBlobValues(89) = &HFF
arrBlobValues(90) = &HFF
arrBlobValues(91) = &H7F
'1er serveur DNS
arrIP = Split(arrDNS(0), ".")
index = 92
For Each octet in arrIP
arrBlobValues(index) = CInt(octet)
index = index + 1
Next
'Si on a qu'un seul serveur dns alors ca sert à rien d'essayer d'en inserer un 2ieme !
if (myvalueDNS = &H08) then
' 2 ieme serveur DNS
arrIP = Split(arrDNS(1), ".")
index = 96
For Each octet in arrIP
arrBlobValues(index) = CInt(octet)
index = index + 1
Next
end if
'mynum permet de créér un décalage d'index si toutes les cases sont pas remplie. Par exemple avec un tableau de 128, on a 2 DNS et 2 WINS, or
'si on tombe sur le cas de 1 DNS et 2 WINS, le 2ieme DNS manquant créé un trou qui génère une erreur. On doit donc décaler les indices du tableau de manière dynamique
'Mynum sert à ça.
Dim mynum
mynum = 0
if (myvalueDNS = &H04) then mynum = 4
if (myvalueWINS <> 0) then
arrBlobValues(100-mynum) = &H2C
arrBlobValues(101-mynum) = &H00
arrBlobValues(102-mynum) = &H00
arrBlobValues(103-mynum) = &H00
arrBlobValues(104-mynum) = &H00
arrBlobValues(105-mynum) = &H00
arrBlobValues(106-mynum) = &H00
arrBlobValues(107-mynum) = &H00
arrBlobValues(108-mynum) = myvalueWINS
arrBlobValues(109-mynum) = &H00
arrBlobValues(110-mynum) = &H00
arrBlobValues(111-mynum) = &H00
arrBlobValues(112-mynum) = &H00
arrBlobValues(113-mynum) = &H00
arrBlobValues(114-mynum) = &H00
arrBlobValues(115-mynum) = &H00
arrBlobValues(116-mynum) = &HFF
arrBlobValues(117-mynum) = &HFF
arrBlobValues(118-mynum) = &HFF
arrBlobValues(119-mynum) = &H7F
'1er serveur WINS
arrIP = Split(arrWINS(0), ".")
index = 120-mynum
For Each octet in arrIP
arrBlobValues(index) = CInt(octet)
index = index + 1
Next
if (myvalueWINS = &H08) then
'2 ieme serveur WINS
arrIP = Split(arrWINS(1), ".")
index = 124-mynum
For Each octet in arrIP
arrBlobValues(index) = CInt(octet)
index = index + 1
Next
end if
end if
'On insère la clé binaire contenant toute la configuration alternative (IP, Mask, Gateway, DNS, WINS)
strKeyPath = "SYSTEM\CurrentControlSet\Services\Dhcp\Configurations\Alternate_" & mySID
Returned = objReg.CreateKey(HKEY_LOCAL_MACHINE, strKeyPath)
Returned = objReg.SetBinaryValue(HKEY_LOCAL_MACHINE, strKeyPath, "Options", arrBlobValues)

Option explicit
'On error resume next
'Script permettant d'activer la configuration alternative IP
'Pour cela on recupere d'abord la clé SID dans le registre correspondant a la bonne interface
'en faisant une comparaison avec les données (pour la trouver)
'après quoi on y rajoute des clés de registre et on active le dhcp.
Dim strComputer
Dim objWMIService
Dim colAdapters
Dim objAdapter
Dim sIP
Dim sMask
Dim sGateway

'On recupere IP + Mask + Passerelle
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\"& strComputer & "\root\cimv2")
Set colAdapters = objWMIService.ExecQuery ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each objAdapter in colAdapters
	sIP = objAdapter.IPAddress(0)
	sMask = objAdapter.IPSubnet(0)
	sGateway = objAdapter.DefaultIPGateway(0)
	Exit For
Next

'On va chercher dans le registre l'interface correspondante
Dim objReg
Dim strKeyPath
Dim subkey
Dim arrSubkeys
Dim arrValueTypes
Dim arrValueNames
Dim arrStrValue
Dim mySID
Dim strValue
Dim Returned
const REG_SZ = 1
const REG_EXPAND_SZ = 2
const REG_BINARY = 3
const REG_DWORD = 4
const REG_MULTI_SZ = 7
const HKEY_LOCAL_MACHINE = &H80000002

Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\"& strComputer & "\root\default:StdRegProv")
strKeyPath = "SYSTEM\CurrentControlSet\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}"
objReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys

'On cherche la clé de la bonne interface
mySID = ""
strValue = ""
For Each subkey In arrSubKeys
	'On exclut la clé Descriptions et on regarde toutes les autres clés SID
	If (subkey <> "Descriptions") then 
		Returned = objReg.GetStringValue(HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey & "\Connection", "Name", strValue)
		If (strValue = "Local Area Connection") OR  (strValue = "Connexion au réseau local") then
			mySID = subkey
			Exit For
		End if
	End if
Next
'mySID contient la clé SID de la bonne interface carte reseau local


'Pour rappel on a déjà l'ip, le mask et la passerelle de l'interface
'sIP et sMask et sGateway
'Maintenant il nous faut le wins (si existant) et les serveurs DNS
'Pour le dns: HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\{491CBE6B-84AD-408C-8DC3-A041326646E6}
'Pour le WINS : HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\NetBT\Parameters\Interfaces\Tcpip_{491CBE6B-84AD-408C-8DC3-A041326646E6}
'NameServerList (REG_MULTI_SZ) => wins
'NameServer (REG_SZ) => DNS
strValue = ""
strKeyPath = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces"
Returned = objReg.GetStringValue(HKEY_LOCAL_MACHINE, strKeyPath & "\" & mySID, "NameServer", strValue)

Dim arrDNS, arrWINS
arrDNS = Split(strValue, ",")

strKeyPath = "SYSTEM\CurrentControlSet\Services\NetBT\Parameters\Interfaces\Tcpip_"
Returned = objReg.GetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath & mySID, "NameServerList", arrWINS)

'Les WINS sont retournes de base dans un tableau, on va donc voir le nombre de WINS inséré dans le tableau et les concaténer dans une chaine de caractere
If (UBound(arrWINS) >= 0) then
	If (UBound(arrWINS) = 0) then sWINS = arrWINS(0)
	If (UBound(arrWINS) = 1) then sWINS = arrWINS(0) & "," & arrWINS(1)
End if
Returned = objReg.SetStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "WINS", sWINS)


'Creation de la valeur ActiveConfigurations pour activer la configuration alternative
arrStrValue = ""
strKeyPath = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\" & mySID
arrStrValue = Array("Alternate_" & mySID)
Returned = objReg.SetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "ActiveConfigurations", arrStrValue)

'Activation DHCP
Returned = objReg.SetDWORDValue(HKEY_LOCAL_MACHINE, strKeyPath, "EnableDHCP", 1)

'Vidage des champs sur le premier onglet de la configuration IP
Returned = objReg.SetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "DefaultGateway", Array())
Returned = objReg.SetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "DefaultGatewayMetric", Array())
Returned = objReg.SetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "IPAddress", Array())


Returned = objReg.SetMultiStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "SubnetMask", Array())
Returned = objReg.SetStringValue(HKEY_LOCAL_MACHINE, strKeyPath, "NameServer", "")


Dim myvalueWINS, myvalueDNS
'On vérifie qu'on a bien des WINS

myvalueWINS = 0
myvalueDNS = &H04
If (UBound(arrWINS) >= 0) then
	If (UBound(arrWINS) = 0) then myvalueWINS = &H04
	If (UBound(arrWINS) = 1) then myvalueWINS = &H08
End if

If (UBound(arrDNS) >= 0) then
	If (UBound(arrDNS) = 0) then myvalueDNS = &H04
	If (UBound(arrDNS) = 1) then myvalueDNS = &H08
End if

'Maintenant il reste plus qu'à basculer toutes les informations IP, MASK, GATEWAY, DNS, WINS dans la configuration alternative
'Le format des IP est special: les 20 premières valeures sont fixes.
'Tableau de 95 quand 1 DNS
'Tableau de 99 quand 2 DNS
'Tableau de 127 quand 2 dns et 2 wins
'Tableau de 123 qunad 2 dns et 1 wins
'Tableau de 99 quand 1 dns et 1 wins
Dim arrBlobValues()
If (myvalueDNS = &H04 AND myvalueWINS = 0) then 
	ReDim arrBlobValues(95)
elseif (myvalueDNS = &H04 AND myvalueWINS = &H04) then 
	ReDim arrBlobValues(119)
elseif (myvalueDNS = &H04 AND myvalueWINS = &H08) then 
	ReDim arrBlobValues(123)
elseif (myvalueDNS = &H08 AND myvalueWINS = 0) then
	ReDim arrBlobValues(99)
elseif (myvalueDNS = &H08 AND myvalueWINS = &H04) then
	ReDim arrBlobValues(123)
elseif (myvalueDNS = &H08 AND myvalueWINS = &H08) then 
	ReDim arrBlobValues(127)
end if


arrBlobValues(0)  = &H32
arrBlobValues(1)  = &H00
arrBlobValues(2)  = &H00
arrBlobValues(3)  = &H00
arrBlobValues(4)  = &H00
arrBlobValues(5)  = &H00
arrBlobValues(6)  = &H00
arrBlobValues(7)  = &H00
arrBlobValues(8)  = &H04
arrBlobValues(9)  = &H00
arrBlobValues(10) = &H00
arrBlobValues(11) = &H00
arrBlobValues(12) = &H00
arrBlobValues(13) = &H00
arrBlobValues(14) = &H00
arrBlobValues(15) = &H00
arrBlobValues(16) = &HFF
arrBlobValues(17) = &HFF
arrBlobValues(18) = &HFF
arrBlobValues(19) = &H7F
'On insère les 4 octets de données correspondant à l'IP dans le tableau d'index soit 20 - 23
Dim arrIP
Dim octet
Dim index

arrIP = Split(sIP, ".")
index = 20
For Each octet in arrIP
	arrBlobValues(index) = CInt(octet)
	index = index + 1
Next

arrBlobValues(24) = &H01
	arrBlobValues(25) = &H00
	arrBlobValues(26) = &H00
	arrBlobValues(27) = &H00
	arrBlobValues(28) = &H00
	arrBlobValues(29) = &H00
	arrBlobValues(30) = &H00
	arrBlobValues(31) = &H00
	arrBlobValues(32) = &H04
	arrBlobValues(33) = &H00
	arrBlobValues(34) = &H00
	arrBlobValues(35) = &H00
	arrBlobValues(36) = &H00
	arrBlobValues(37) = &H00
	arrBlobValues(38) = &H00
	arrBlobValues(39) = &H00
	arrBlobValues(40) = &HFF
	arrBlobValues(41) = &HFF
	arrBlobValues(42) = &HFF
	arrBlobValues(43) = &H7F

arrIP = Split(sMask, ".")
index = 44
For Each octet in arrIP
	arrBlobValues(index) = CInt(octet)
	index = index + 1
Next

arrBlobValues(48) = &H03
	arrBlobValues(49) = &H00
	arrBlobValues(50) = &H00
	arrBlobValues(51) = &H00
	arrBlobValues(52) = &H00
	arrBlobValues(53) = &H00
	arrBlobValues(54) = &H00
	arrBlobValues(55) = &H00
	arrBlobValues(56) = &H04
	arrBlobValues(57) = &H00
	arrBlobValues(58) = &H00
	arrBlobValues(59) = &H00
	arrBlobValues(60) = &H00
	arrBlobValues(61) = &H00
	arrBlobValues(62) = &H00
	arrBlobValues(63) = &H00
	arrBlobValues(64) = &HFF
	arrBlobValues(65) = &HFF
	arrBlobValues(66) = &HFF
	arrBlobValues(67) = &H7F
	
arrIP = Split(sGateway, ".")
index = 68
For Each octet in arrIP
	arrBlobValues(index) = CInt(octet)
	index = index + 1
Next

arrBlobValues(72) = &H06
	arrBlobValues(73) = &H00
	arrBlobValues(74) = &H00
	arrBlobValues(75) = &H00
	arrBlobValues(76) = &H00
	arrBlobValues(77) = &H00
	arrBlobValues(78) = &H00
	arrBlobValues(79) = &H00
	arrBlobValues(80) = myvalueDNS
	arrBlobValues(81) = &H00
	arrBlobValues(82) = &H00
	arrBlobValues(83) = &H00
	arrBlobValues(84) = &H00
	arrBlobValues(85) = &H00
	arrBlobValues(86) = &H00
	arrBlobValues(87) = &H00
	arrBlobValues(88) = &HFF
	arrBlobValues(89) = &HFF
	arrBlobValues(90) = &HFF
	arrBlobValues(91) = &H7F
	

'1er serveur DNS
arrIP = Split(arrDNS(0), ".")
index = 92
For Each octet in arrIP
	arrBlobValues(index) = CInt(octet)
	index = index + 1
Next
'Si on a qu'un seul serveur dns alors ca sert à rien d'essayer d'en inserer un 2ieme !
if (myvalueDNS = &H08) then
	' 2 ieme serveur DNS
	arrIP = Split(arrDNS(1), ".")
	index = 96
	For Each octet in arrIP
		arrBlobValues(index) = CInt(octet)
		index = index + 1
	Next
end if

'mynum permet de créér un décalage d'index si toutes les cases sont pas remplie. Par exemple avec un tableau de 128, on a 2 DNS et 2 WINS, or
'si on tombe sur le cas de 1 DNS et 2 WINS, le 2ieme DNS manquant créé un trou qui génère une erreur. On doit donc décaler les indices du tableau de manière dynamique
'Mynum sert à ça.
Dim mynum
mynum = 0
 if (myvalueDNS = &H04) then mynum = 4
 
if (myvalueWINS <> 0) then 
	arrBlobValues(100-mynum) = &H2C
		arrBlobValues(101-mynum) = &H00
		arrBlobValues(102-mynum) = &H00
		arrBlobValues(103-mynum) = &H00
		arrBlobValues(104-mynum) = &H00
		arrBlobValues(105-mynum) = &H00
		arrBlobValues(106-mynum) = &H00
		arrBlobValues(107-mynum) = &H00
		arrBlobValues(108-mynum) = myvalueWINS
		arrBlobValues(109-mynum) = &H00
		arrBlobValues(110-mynum) = &H00
		arrBlobValues(111-mynum) = &H00
		arrBlobValues(112-mynum) = &H00
		arrBlobValues(113-mynum) = &H00
		arrBlobValues(114-mynum) = &H00
		arrBlobValues(115-mynum) = &H00
		arrBlobValues(116-mynum) = &HFF
		arrBlobValues(117-mynum) = &HFF
		arrBlobValues(118-mynum) = &HFF
		arrBlobValues(119-mynum) = &H7F
		


	'1er serveur WINS
	arrIP = Split(arrWINS(0), ".")
	index = 120-mynum
	For Each octet in arrIP
		arrBlobValues(index) = CInt(octet)
		index = index + 1
	Next
	if (myvalueWINS = &H08) then
	'2 ieme serveur WINS
		arrIP = Split(arrWINS(1), ".")
		index = 124-mynum
		For Each octet in arrIP
			arrBlobValues(index) = CInt(octet)
			index = index + 1
		Next
	end if
end if
'On insère la clé binaire contenant toute la configuration alternative (IP, Mask, Gateway, DNS, WINS)
strKeyPath = "SYSTEM\CurrentControlSet\Services\Dhcp\Configurations\Alternate_"  & mySID
Returned = objReg.CreateKey(HKEY_LOCAL_MACHINE, strKeyPath)
Returned = objReg.SetBinaryValue(HKEY_LOCAL_MACHINE, strKeyPath, "Options", arrBlobValues)

Conclusion

Comme vous pouvez le voir, tout est basé sur du WMI qui attaque le registre!
Si vous avez besoin de renseignement, n'hésitez pas à me demander.

Ceci est ma première source!

Historique

09 février 2007 14:13:31 :: Rajout commentaire.
13 février 2007 07:49:06 :: Correction du commentaire (section Note)
29 août 2008 13:09:23 :: Modification du titre (temporairement) en titre générique.
29 août 2008 13:11:21 :: Un petit oubli.
29 août 2008 13:16:55 :: Désactivation temporaire.
18 décembre 2008 22:36:31 :: j'ai remis le code d'origine.

Sources du même auteur

ECRIRE DANS UNE CONSOLE AVEC VISUAL BASIC (WRITE IN A CONSOL...

Toutes les sources de burster42

Sources de la même categorie

GESTIONNAIRE DE TÉLÉCHARGEMENT, AVEC REPRISE ET MULTITHREADI... par Madx23

CONVERTIR DU TEXTE RTF EN CODE HTML ET VICE-VERSA par vicosta

DICTIONAIRE TEXT/AUDIO/VISUELLE ANGLAIS AVEC WEBBROWSER CONT... par majnounmajda

NSLOOKUP EN VB.NET OU COMMENT FAIRE UNE REQÛETE DNS EN PRÉCI... par ShareVB

MINI SEVEUR HTTP AVEC INTERFACE GRAPHIQUE ET IMPLÉMENTATIONS... par lemout

Toutes les sources de la catégorie Réseau & Internet

Sources en rapport avec celle ci

NSLOOKUP EN VB.NET OU COMMENT FAIRE UNE REQÛETE DNS EN PRÉCI... par ShareVB

PILOTER UN WALLBOARD IP ALCATEL par mays

DNS REDIRECTION par EvildarkEurope

LECTURE DANS LA BDR DE LA 1ERE ADRESSE IP TYPE REG_MULTI_SZ par jean thalus

MASTERLOCATER.NET par MasterHack

Commentaires et avis

Commentaire de burster42 le 13/02/2007 07:50:56

Je vois pas trop en quoi ma source est louche oO ?

Commentaire de NHenry le 13/02/2007 13:01:24 administrateur CS

Bonjour,

C'est quoi APIPA, et comment on le désactive.

Si ta source est marquée ainsi c'est peurt-être parcequ'elle touche proche du système.

Commentaire de burster42 le 14/02/2007 09:09:29

Bonjour,

Dans le cas d'une IP DHCP, quand Windows n'arrive pas à obtenir une IP dynamique, il utilise alors en dernier recours le protocole APIPA (Automatic Private Internet Protocol Addressing)
Ce protocole permet d'attribuer d'office une IP commençant obligatoirement par 169.254.X.X.

Je te renvoie directement à l'article suivant pour plus d'informations:
http://fr.wikipedia.org/wiki/APIPA

Commentaire de NHenry le 14/02/2007 12:48:00 administrateur CS

Merci pour cette précision, Je n'en ai pas l'utilité actuellement, mais ton code est quand même utile (je ne l'ai pas encore testé).

Commentaire de misterj83 le 26/11/2009 14:14:31 10/10

Super code, il me fallait dupliquer la config DHCP des postes de la société ou je bosse et la mettre en config APIPA pour le cas ou le serveur DHCP tombe...
Grace à ce code j'ai pus le faire, à peine 3 lignes à modifier !

Merci !

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

trouver un ip grace a un vbs ??? [ par axeman ] j aimerais savoir si il est possible de recuperer une ip grace a un vbs, afin qu elle me soit renvoyé ensuitemci a tousaxe Script VBS & tse [ par furb59 ] Bonjour,Je suis a la recherche d'un script en vbs (avec WMI ou pas) qui peut me récuperer l'adresse IP du client de connexion TSE.Je m'explique. [VBS] Connaitre l'adresse IP d'un compte d'ordinateur [ par parker13 ] Bonjour, Je souhaiterais écrire un script qui interroge tous les comptes d'ordinateurs, et en fonction de leurs adresses IP, déplacer ces comptes d' Configuration réseau d'un windows XP [ par Gwen38 ] Bonjour Je cherche actuellement à créé un script pour configurer un machine XP grace à une appli en Visual Basic. Mais j'ai un pro Script pour configuration alternative IP [ par g2006 ] Bonjour à tous,J'ai besoin de créer un script pour automatiser la configuration alternative IP (réseau) en fonction de la carte (cad de sa valeur Serv Script installation imprimantes sur un serveur d'impression en VBS [ par kuruma7 ] Bien le bonjour messieurs les développeurs ! (et mesdames les développeuses ) Je suis actuellement en stage afin de préparer mon BTS Informatique de VBS tableau de stat [ par sweetyrahma ] bonjour svp c urgent jai besoin de vos aide , je travaille un project en VBS , il s'agit de traiter un fichier log qui contient des évenements(erreur Conversion Batch en VBS [ par rhunter ] Bonjour, Je souhaite et dois (pour mon entreprise) refaire un script que j'ai fait en batch en VBS, je n'y connais pas encore grand chose. voici mon

Nos sponsors

Derniers Blogs

ASYNC/AWAIT: COMPRENDRE COMMENT CA MARCHE par fathi

PAS D'INTELLITRACE SUR MON SITE WEB DANS IIS ! par Etienne Margraff

OFFICE 365 - SHAREPOINT ONLINE, QUELQUES LIMITATIONS par junarnoalg

PRéSENTATION DES API REST DE WINDOWS AZURE : LISTER LES COMPTES DE STORAGE par richardc

PRéSENTATION DES API REST DE WINDOWS AZURE : 1èRE éTAPE, LE CERTIFICAT par richardc

Forum

RE : PROCESSUS "INTUABLE" par acive

RE : PROCESSUS "INTUABLE" par ghighidu63

RE : PROCESSUS "INTUABLE" par acive

RE : PROCESSUS "INTUABLE" par ghighidu63

RE : PROCESSUS "INTUABLE" par acive

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

Configuration de Virtuemart pour Fianet
Budget : 300€
Creation d-une application web Prediction Energy Tool-CDC DISPONIBLE-REPUBLICATION
Budget : 12 000€
Finalisation site d-encheres au centime
Budget : 2 800€

Logiciels

DocTranslate (V3.1.0.0)
DOCTRANSLATE (V3.1.0.0)

DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom...

Cliquez pour télécharger DocTranslate
Tribler (2012)
TRIBLER (2012)

Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des...

Cliquez pour télécharger Tribler
OneSwarm (2012)
ONESWARM (2012)

Le peer-to-peer qui protège votre vie privée, c'est OneSwarm. Ce logiciel de peer-to-peer crypté...

Cliquez pour télécharger OneSwarm
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)

PONAMEDIA TV DEVIENS HELLLOOO FLASH LA TV SUR VOTRE ORDINATEUR. Toute une plateforme Multi...

Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO
Academy System (17.2.1.0)
ACADEMY SYSTEM (17.2.1.0)

Logiciel de gestion des établissements. - élèves/étudiants (inscription, dossier, absence...) -...

Cliquez pour télécharger Academy System