Modifier paramètres d'un portable suivant le reseau

Description

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

Codes Sources

A voir également

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.