Utlisateur d'un portable sur trois reseaux j'ai eu le problème suivant :
A chaque reseau son propre SMTP (merci les FAI), sa propre imprimante, ses propre lecteurs reseaux (et j'en ai), ... Ce programme permet de résoudre ces problèmes en essyant de trouver sur quel reseau est situé le portable.
Le programme fonctionne ainsi (deux méthodes):
Il ping quelque ip (méthode 1) et cherche laquelle répond. A vous de définir quelles ip doivent être les identificateurs de chaque reseau. Si cette méthode echoue, il cherche alors (méthode 2) à voir quel ip vous avez sur le net. Puis à configurer le smtp par defaut de votre poste
Suivant la première ip qui répond, il modifiera vos paramètres comme indiqué dans le fichier xml.
Installation :
Les fichiers MySMTP.xml et Nomade_networking.exe doivent être situés dans le même répertoire
Modifiez le fichier xml comme suit :
Il est composé de deux parties "ping" et "SMTPSettings"
- la partie SMTPSetting contient la liste des smtp correspondant à votre ip sur le net. Cette méthode est un peu aléatoire mais permet quand même de profiter de retrouver sur quel fournisseur d'accès on se trouve (c'est ce qui est utilisé dans la méthode 2) : les ip de wanadoo son du type 81., celle de neuf du type 90., ...
- la partie ping est plus fournie. Chaque "locationtoping" est un reseau différent avec les paramètres suivants :
Champs Obligatoires :
search : l'IP à Pinger pour identifier ce reseau
name : le nom du reseau (maison, travail, ...)
smtp : le nom du smtp à utiliser
card_name : le nom de la carte reseau
gateway : la passerelle.
si ce champ contient DHCP alors la carte se mettra en dhcp
sinon il faudra indiquer les champs suivants :
Champs Optionnel :
myip : l'ip de la carte
mymask : le masque du reseau
mygatewaymetric : le nombre de routeur entre le pc et la passerelle (généralement 1)
les options du logiciels :
map_drive : vous pouvez connecter des lecteurs reseau à chaque reseau
launch : lancer des application
printer : définir l'imprimante par defaut
Il est possible de forcer un reseau en, appelent le logiciel avec le nom du reseau en paramètre : "nomade_networking.exe home" forcera la reconnaissance du reseau home.
Je ne suis pas l'auteur de tout le code. Il est inspiré au début d'un truc que j'ai vu sur le net mais qui n'était pas trés pratique : il s'executait dans outlook (vba) dans une macro... (source :
http://www.commentcamarche.net/forum/affich-2207751-changement-d-adresse-smtp-sur-outlook-express) et s'est agrégé d'option.
Comme d'habitude, si un bout ou la totalité de votre disque dur venait à s'effacer lors de l'execition de ce code, je nierais avoir eu connaissance de vos activités.
Source / Exemple :
Imports System.IO
Imports System.Net.Sockets
Imports System.Drawing.Printing
Imports System.Runtime.InteropServices
Imports System.Net.NetworkInformation
Module Moteur
Sub Main()
' can be forced to a specific network this way : <app_name> <Networktoforce>
Dim args As String() = Environment.GetCommandLineArgs()
Dim LookFor As String
' force a place in command line
If args.Length > 1 Then
LookFor = args(1)
Else
LookFor = ""
End If
' Quick and efficient ;)
If Not My.Computer.Network.IsAvailable Then Exit Sub
Console.Write("Check SMTP" & vbCrLf & "First pass with actual config" & vbCrLf)
If try_once(LookFor) = 1 Then Exit Sub
Console.Write("Notinhg found = > Change to DHCP " & vbCrLf)
Dim adapts As NetworkInterface() = NetworkInterface.GetAllNetworkInterfaces
Dim LANinterfaces(5) As String
For Each adapt As NetworkInterface In adapts
Shell("netsh interface ip set address """ & adapt.Name & """ dhcp")
's &= "Nom : " & adapt.Name & vbCrLf
's &= "Description :" & adapt.Description & vbCrLf
's &= "Statut : " & adapt.OperationalStatus.ToString & vbCrLf
's &= (adapt.Speed / 1000000).ToString & "Mb" & vbCrLf
's &= "MAC :" & adapt.GetPhysicalAddress.ToString & vbCrLf
's &= vbCrLf
Next
try_once(LookFor)
End Sub
Function try_once(ByVal LookFor As String) As Integer
Dim MonIPPublic, IPPublic, strLine, MonSMTP, MonIPSMTP As String
Dim i, DebIPSmtp, FinIPSmtp As Integer, DebRep, FinRep As Long
' pour fichier config
Dim fichier_temp, new_ip As String
Dim sep As Integer
Dim objStreamReader As StreamReader
Dim objStreamWriter As StreamWriter
Dim LanSet, ThisLanIsTheGood As Boolean
Try
' Disconnect all network drives
Shell("net use * /d /y")
' <load Config File>
Dim Asm As System.Reflection.Assembly = System.Reflection.Assembly.GetExecutingAssembly
Dim FileInfo As System.IO.FileInfo = New System.IO.FileInfo(System.IO.Path.GetDirectoryName(Asm.Location) & "\MySMTP.xml")
' Load the config file into the XML DOM.
Dim XmlDocument As New System.Xml.XmlDocument()
XmlDocument.Load(FileInfo.FullName)
' </load Config File>
' <Ping some adresses and Loads xml file>
Dim strIPAddress, strSubnetMask, strGateway, strCardName, strMetric As String
Dim Node, SelectecNode, ChildNode As System.Xml.XmlNode
strMetric = ""
strIPAddress = ""
strSubnetMask = ""
strGateway = ""
strCardName = ""
MonIPSMTP = ""
MonSMTP = ""
MonIPPublic = ""
' Lan is not set yet
LanSet = False
For Each Node In XmlDocument.Item("configuration").Item("ping")
If Node.Name = "locationtoping" Then
Try
Console.Write("Is this Network " & Node.Item("name").InnerText & vbCrLf)
ThisLanIsTheGood = (LookFor.ToLower = Node.Item("name").InnerText.ToLower And LookFor <> "")
If (Not ThisLanIsTheGood And LookFor = "") Then
' ping adresses
If My.Computer.Network.Ping(Node.FirstChild.InnerText) Then
ThisLanIsTheGood = True
Else
ThisLanIsTheGood = False
End If
End If
If ThisLanIsTheGood Then
' adresse respond should be good if user is clever on definition of his addresses
Console.Write("yes" & vbCrLf)
LanSet = True
For Each SelectecNode In Node
' configure thing switch files in xml files
Select Case SelectecNode.Name
Case "name" : Console.Write("Reseau détecté : " & SelectecNode.InnerText & vbCrLf)
Case "smtp" : MonSMTP = SelectecNode.InnerText
Case "card_name" : strCardName = SelectecNode.InnerText
Case "myip" : strIPAddress = SelectecNode.InnerText
Case "mymask" : strSubnetMask = SelectecNode.InnerText
Case "gatewaymetric" : strMetric = SelectecNode.InnerText
Case "mygateway" : strGateway = SelectecNode.InnerText
' mygate way found : so ip is to configure if ip <> current one
Dim client2 As New TcpClient
Try
client2.ReceiveTimeout = 10000
client2.Connect(Node.FirstChild.InnerText, 80)
Console.Write("Change IP to : " & strIPAddress & vbCrLf)
Console.Write("Même IP" & vbCrLf)
Catch e As System.Net.Sockets.SocketException
If strGateway <> "DHCP" Then
Shell("netsh interface ip set address """ & strCardName & """ dhcp")
Else
Shell("netsh interface ip set address """ & strCardName & """ static " & strIPAddress & " " & strSubnetMask & " " & strGateway & " " & strMetric)
End If
End Try
client2.Close()
Case "map_drive"
' some network drives ?
Console.Write("Mapping Drives :" & vbCrLf)
For Each ChildNode In SelectecNode
Shell("net use " & ChildNode.FirstChild.InnerText & ": " & ChildNode.LastChild.InnerText)
Next
Case "MonIPSMTP" : MonIPSMTP = SelectecNode.InnerText ' static ip for the location ?
Case "launch"
' any specifis thing to launch ? (mouse drivers)
For Each ChildNode In SelectecNode
Shell(ChildNode.FirstChild.InnerText)
Next
Case "printer"
' Set default printer
Dim strOldPrinter As String
Dim WshNetwork As Object
Dim pd As New PrintDocument
strOldPrinter = ""
Try
strOldPrinter = pd.PrinterSettings.PrinterName
WshNetwork = Microsoft.VisualBasic.CreateObject("WScript.Network")
WshNetwork.SetDefaultPrinter(SelectecNode.InnerText)
pd.PrinterSettings.PrinterName = SelectecNode.InnerText
If pd.PrinterSettings.IsValid Then
Console.Write("Default printer : " & SelectecNode.InnerText & vbCrLf)
Else
WshNetwork.SetDefaultPrinter(strOldPrinter)
Console.Write("Default printer (" & SelectecNode.InnerText & ") is dicsonnected" & vbCrLf)
End If
Catch exptd As Exception
WshNetwork.SetDefaultPrinter(strOldPrinter)
Console.Write("bad")
Finally
WshNetwork = Nothing
pd = Nothing
End Try
End Select
Next
Exit For
End If
Catch e As System.Net.Sockets.SocketException
Console.Write("Bad Network " & Node.Item("name").InnerText & vbCrLf)
End Try
End If
Next
' </change IP et lecteur reseau>
' <lan not set => find MonSTMP with another method : Try to detect my provider>
If Not LanSet Then
' So is get with DHCP :(
IPPublic = ""
MonIPPublic = ""
' Cherche mon ip sur le net
OuvreUrl1(IPPublic, DebRep, FinRep)
If IPPublic = "" Then
Return 0
End If
MonIPPublic = Mid$(IPPublic, DebRep, FinRep - DebRep)
For Each Node In XmlDocument.Item("configuration").Item("SMTPSettings")
' Skip any comments.
If Node.Name = "location" Then
If InStr(1, IPPublic, Node.FirstChild.InnerText) > 0 Then
MonSMTP = Mid$(Node.LastChild.InnerText, 1, Node.LastChild.InnerText.Length)
Exit For
End If
End If
Next Node
End If
' </lan not set => find MonSTMP with method 2 : Try to detect my provider>
fichier_temp = ""
For Each Node In XmlDocument.Item("configuration").Item("appSettings")
fichier_temp = Node.Attributes.GetNamedItem("value").Value
Shell(Environ$("comspec") & " /c tracert -h 1 -w 1 " & MonSMTP & " >""" & fichier_temp & """")
Next
' Création d'un nouveau reseau
If MonSMTP = "" Then
Console.Write("Le reseau est inconnu !" & vbCrLf)
MonSMTP = InputBox("Bonjour", "Quel SMTP dois-je ajouter ?")
If MonSMTP = "" Then
Console.Write("Abandon !" & vbCrLf)
Return 0
End If
sep = InStr(1, MonIPPublic, ".")
new_ip = Mid$(MonIPPublic, 1, sep)
Dim new_node As System.Xml.XmlNode
new_node = XmlDocument.CreateElement("location")
new_node.InnerXml = "<ip>" & new_ip & "</ip><smtp>" & MonSMTP & "</smtp>"
XmlDocument.Item("configuration").Item("SMTPSettings").AppendChild(new_node)
End If
' Save the modified config file.
XmlDocument.Save(FileInfo.FullName)
' <usually we won't konw the ip of the smtp, but some may konw it> (big netowrk)
If MonIPSMTP = "" Then
' Créer le fichier temp
Shell(Environ$("comspec") & " /c tracert -h 1 -w 1 " & MonSMTP & " >""" & fichier_temp & """")
i = 0
While Active_FILE(fichier_temp) = True And i < 10
Console.Write(".")
i = i + 1
End While
Console.Write(vbCrLf)
' Cherche l'IP du SMTP
objStreamReader = New StreamReader(fichier_temp)
strLine = objStreamReader.ReadLine()
MonIPSMTP = ""
Do
If Left$(strLine, 12) = "Dtermination" Then
DebIPSmtp = InStr(1, strLine, "[") + 1
FinIPSmtp = InStr(DebIPSmtp + 1, strLine, "]")
MonIPSMTP = Mid$(strLine, DebIPSmtp, FinIPSmtp - DebIPSmtp)
Console.Write("Mon SMTP : " & MonIPSMTP & vbCrLf)
Exit Do
End If
strLine = objStreamReader.ReadLine()
Loop Until strLine Is Nothing
objStreamReader.Close()
If MonIPSMTP = "" Then
Console.Write("Aucun reseau trouvé")
Return 0
End If
End If
' </usually we won't konw the ip of the smtp, but some may konw it> (big netowrk)
' <check if SMTP is set>
objStreamReader = New StreamReader(Environ$("windir") & "\system32\drivers\etc\Lmhosts")
strLine = objStreamReader.ReadLine()
Do
If strLine = MonIPSMTP & " CurrentSmtp" Then
objStreamReader.Close()
Console.Write("Même Reseau qu'avant" & vbCrLf)
Return 1
End If
strLine = objStreamReader.ReadLine()
Loop Until strLine Is Nothing
objStreamReader.Close()
' </check if SMTP is set>
' <write the SMTP's ip>
' Ecrit l'IP du SMTP dans LMHOSTS
objStreamWriter = New StreamWriter(Environ$("windir") & "\system32\drivers\etc\Lmhosts")
objStreamWriter.WriteLine(MonIPSMTP & " CurrentSmtp" & vbCrLf & vbCrLf & vbCrLf & vbCrLf)
objStreamWriter.Close()
' Recharge la table de routage
Console.Write(vbCrLf)
Shell(Environ$("comspec") & " /c nbtstat -R" & vbCrLf)
' </write the SMTP's ip>
' Affiche bye bye
Console.Write("Mon IP Public : " & MonIPPublic & vbCrLf & "Serveur SMTP activé : " & MonSMTP & vbCrLf)
'MsgBox("Mon IP Public : " & MonIPPublic & vbCrLf & "Serveur SMTP activé : " & MonSMTP)
Catch ex As Exception
Console.Write("Erreur critique : " & ex.Message)
'MsgBox("Une erreure critique : " & ex.Message)
End Try
End Function
Public Function OuvreUrl1(ByRef IPPublic, ByRef DebRep, ByRef FinRep)
Dim UrlTest As String
Dim wnh As Object
wnh = CreateObject("WinHttp.WinHttpRequest.5.1")
Try
UrlTest = "http://www.monip.org"
wnh.Open("GET", UrlTest, False)
wnh.Send()
If IPPublic = "" Then
IPPublic = wnh.ResponseText
DebRep = InStr(1, IPPublic, "<BR>IP : ") + 9
FinRep = InStr(DebRep, IPPublic, "<br>")
Return ""
ElseIf IPPublic = "http://www.monip.org" Then
UrlTest = "http://www.mywanip.com/?advanced=true"
wnh.Open("GET", UrlTest, False)
wnh.Send()
IPPublic = wnh.ResponseText
DebRep = InStr(1, IPPublic, "True Internet (WAN) Address:") + 28
FinRep = InStr(DebRep, IPPublic, "</li>")
Return ""
ElseIf IPPublic = "http://www.mywanip.com/?advanced=true" Then
UrlTest = "http://checkip.dyndns.org"
wnh.Open("GET", UrlTest, False)
wnh.Send()
IPPublic = wnh.ResponseText
DebRep = InStr(1, IPPublic, "Current IP Address:") + 20
FinRep = InStr(DebRep, IPPublic, "</body>")
End If
Catch ex As Exception
Console.Write("Reseau débranché! ")
'MsgBox("Une erreure critique : " & ex.Message)
End Try
Return IPPublic
End Function
' Cherche à voir si la command est effectuée
Function Active_FILE(ByVal fichier_temp As String) As Boolean
Dim objStreamReader As StreamReader
Try
objStreamReader = New StreamReader(fichier_temp)
objStreamReader.Close()
Active_FILE = False
Catch ex As Exception
System.Threading.Thread.Sleep(1000)
Active_FILE = True
End Try
End Function
End Module
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.