MODIFIER PARAMÈTRES D'UN PORTABLE SUIVANT LE RESEAU

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

Télécharger le zip

19 février 2007 17:03:08 :

permet maintenant de choisir les lecteur reseau, l'imprimante par defaut, les logiciels à lancer...

22 mai 2007 19:26:20 :

Mise à jour du ping qui etait trop long et quelques optoimisations de codes par ci par là....