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

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

Cliquez ici pour mettre ce site au démarrage de votre navigateur

AccueilCodesTutorielsForumsEmploiLivresGuide achatConnexion

begin process at 2009 07 05 23:40:56

SILVERLIGHT 3 : COMMUNICATION ET MULTICAST par KooKiz

[PERSO] DéCOUVERTES ESTIVALES : LINUX (PART I) par FREMYCOMPANY

[REFACTORING] RESHARPER POUR VISUAL STUDIO 2010 (PREVIEW) par tja

[REFACTORING] ANALYSER VOS EXCEPTIONS AVEC RESHARPER EXCEPTIONAL par tja

SHAREPOINT 2007 : PATTERNS & PRACTICES SHAREPOINT GUIDANCE par phil

RE : BUFFERING par pingouin84k

RE : SIMULER CTRL+A PUIS CTRL+C NE MARCHE PAS TOUT LE TEMPS .. POURQUOI ? par Renfield

RE : PROBLEME DANS BASE DE DONNéES par PCPT

RE : PROBLEME DANS BASE DE DONNéES par Tursiop60

RE : PROBLEME DANS BASE DE DONNéES par PCPT

+ de logiciels à télécharger

1 464 926 membres
424 nouveaux aujourd'hui
15 045 membres club

Trouver une ressource

Trouvez une ressource parmi 40 095 codes, 1 303 031 messages d'aide etc...

Recherche: dans [ Dernières recherches ]

Filtre:Tous les codes.NET uniquementExclure .NET

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

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!

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 : 5 798

Auteur : burster42

Site perso

Ecrire un message privé

Note :
Aucune note

Commentaire sur cette source (4)

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

LIGHT CODES-SOURCES par thebigboss3

STORMDATACENTER - DÉMO DE WEBBROWSER MULTIFONCTION VB9 par LightningStrike

TRADUCTEUR GOOGLE : INTERFACE WINFORM POUR LE SERVICE DE TRA... par Patrice99

COMMENT CONTRÔLER TOTALEMENT LES PROCESSUS D'UN PC DISTANT (... par violent_ken

MINI CACHE DNS par XelectroX

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

Sources en rapport avec celle ci

CALCULATEUR DE SOUS RESEAUX IP. par f4dtr

[VB.NET 2008] ACTIVATION DE LOGICIEL AVEC PHP ET MYSQL BETA ... par xarsoft

CONTROLE UTILISATEUR IPBOX POUR LA SAISIE D'ADRESSE IP par foliv57

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

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

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é).

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