IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBScript Discussion :

VBscript: Boite de dialogue pour saisir une @ IP


Sujet :

VBScript

  1. #1
    Membre averti
    Femme Profil pro
    Inscrit en
    Mars 2013
    Messages
    16
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France

    Informations forums :
    Inscription : Mars 2013
    Messages : 16
    Par défaut VBscript: Boite de dialogue pour saisir une @ IP
    Bonjour à tous,

    Je souhaite avoir une boite de dialogue pour saisir l'@ IP et cela avec VBscript.
    Je voudrai qu'elle soit comme en pièce jointe: avec des points..etc.
    Merci d'avance pour votre aide.

    Voici mon
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    switch = InputBox("Entrez le nom du switch:", "Switch name","")
    ip = InputBox("Entrez l'adresse ip du Switch:", "ip address","")
    gateway = InputBox("Entrez la passerelle", "gateway default","")
    Merci encore
    Images attachées Images attachées  

  2. #2
    Expert confirmé
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 844
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 844
    Par défaut
    et Bienvenue sur DVP
    Donc, si j'ai bien compris votre demande, c'est que vous voulez inviter un utilisateur à saisir les paramètres comme adresse IP, masque sous réseau, gataway,DNS1,DNS2 etc.... comme dans l'image que vous avez posté
    et ceci dans le but pour les changer c'est ça

  3. #3
    Membre averti
    Femme Profil pro
    Inscrit en
    Mars 2013
    Messages
    16
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France

    Informations forums :
    Inscription : Mars 2013
    Messages : 16
    Par défaut
    En effet mon but est de saisir ces données mais pas de les changer car il n'existe pas. je vais inviter l'utilisateur à les saisir et cela avec VBscript(car j'ai déjà travailler avec!).
    Merci

  4. #4
    Expert confirmé
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 844
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 844
    Par défaut

    un début de script avec test de validité de l'adresse ip saisi par l’utilisateur
    Exemple :
    • 172.16.18.21 est une adresse ip Valide
    • 300.22.194.37 est une adresse ip non Valide
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    Titre = "Tester la validité d'une d'Adresse IP"
    AdressIP = InputBox("Veuillez saisir une Adresse IP ",Titre,"172.16.18.21")
    if IP_Valide(AdressIP) = True Then
    	MsgBox AdressIP & " est une Adresse IP Valide",64,Titre
    else
    	MsgBox AdressIP & " est une Adresse IP NON Valide",16,Titre
    End if
     
    gateway = InputBox("Entrez la passerelle", "gateway default","255.255.255.0")
    if IP_Valide(gateway) = True Then
    	MsgBox gateway & " est une Adresse IP Valide",64,Titre
    else
    	MsgBox gateway & " est une Adresse IP NON Valide",16,Titre
    End if
     
    Function IP_Valide(ip)
    	Set RegularExpressionObject = New RegExp
    	With RegularExpressionObject
    		.Pattern = "^((25[0-5]|2[0-4]\d|1?\d?\d)\.){3}(25[0-5]|2[0-4]\d|1?\d?\d)$"
    		.IgnoreCase = False
    		If .Test(ip)= True then
    			IP_Valide = True
    		end if
    	End With
    End Function

  5. #5
    Membre averti
    Femme Profil pro
    Inscrit en
    Mars 2013
    Messages
    16
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France

    Informations forums :
    Inscription : Mars 2013
    Messages : 16
    Par défaut
    Merci pour ta réponse.
    Ce code est très intéressant dans la mesure ou il va me permettre d'indiquer des @ip interdites.
    Peux tu m'expliquer un peu plus en détail le fonctionnement de la fonction IP_Valide(ip)?

    P.S: au point de vue esthétique, il serait intéressant que je laisse libre choix à l'utilisateur de saisir une @ip en mettant dans la boite de dialogue juste des point et des espaces:
    . . . !

    Merci encore

  6. #6
    Expert confirmé
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 844
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 844
    Par défaut
    Citation Envoyé par honey2 Voir le message
    Peux tu m'expliquer un peu plus en détail le fonctionnement de la fonction IP_Valide(ip)?
    D'après la Comment tester une chaîne de caractères avec une expression régulière ?

    un tutoriel sur les expressions régulières

    Bonne lecture

  7. #7
    Expert confirmé
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 844
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 844
    Par défaut
    Pour tester vos motifs de vos expressions régulières: RegExp Tester.hta
    J'ai trouvé cet outil en HTA dans un forum anglais, donc copier et coller ce code et enregistrez-sous le nom RegExp Tester.hta, puis il vous reste juste à construire et à tester vos motifs avec ce dernier
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    <html>
     <head>
     <title>Regex Tester</title>
     <HTA:APPLICATION
     icon = "explorer.exe"
     Caption = "yes"
     Version = "3.0"
     />
     <META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
     <!-- Author : Mike D Adams <a href="mailto:michael.david.adams@gmail.com">michael.david.adams@gmail.com</a>
     Thanks to Jared Franklin for the submatches portion. 
     Thanks to all the suggestion and help from the users of the visualbasicscript.com forums
     2007/01/19
     -    Added prompt for over-writing of files for
     -  Templates and settings save.
     -    Added load file boolean check. Now throws error in html.
     -    Added icon to over-write prompt
     -    Cleaned excessive if's from fileLoader subroutine
     -    Updated template wording to make more sense
     -    Started to fix tab issues with code layout.
     -    Version jump to 3.0
     2006/07/25
     -    Added tool-tips on text areas for exp and string
     -    Changed the color of all text areas to match the "theme" of the app
     2006/07/24 
     -     fixed some issues in the text processing portion (load/unload files)
     -    Added Tooltips for almost all buttons
     -    Disabled other file options once you have one selected
     -    Renamed close button to hide. Clarity sake
     -    Changed the file text to blue w\ a size of +1
     -    Added tooltips to the checkboxes
     -    Jumped version number to 2.5 (from 2.0)
     
     -->
     <script language="VBScript">
     '#################### Start VBScript Section ####################
     
     ''= refreshes the HTA page, which includes re-running any Windows_Onload code
     '' ============================================================================
     Sub reloadHTA()
         location.reload( True )
     End Sub
     
     'Sub to Run when Test RegEx button is pressed
     sub cmdTextBox
     dim string1, Re,s,colMatches,Test,ResultArr()
     
     'Configure Regular Expression
     set Re = new RegExp
     Re.Pattern = ExprStrin.TextBox.value
     
     ' Error if pattern is blank
     if Re.Pattern = "" Then
           strError = "<font color=red>Please enter a Regular Expression!</font>"
       DataAr1.InnerHTML = strError
       SubAr1.InnerHTML = strError
       strError = ""
     
     'Move on pattern is not blank
     else
       If ExprStrin.GlobalCheckBox.checked Then    'Set Global attribute according to checkbox
           Re.Global = true
       Else
           Re.Global = false
       End If
     
       If ExprStrin.caseCheckbox.checked Then    'Set IgnoreCase attribute according to checkbox
           Re.IgnoreCase = True
       Else
           Re.IgnoreCase = False
       End If
     
       If ExprStrin.MultilineCheckBox.checked Then    'Set Multiline attribute according to checkbox
             Re.Multiline = True
         Else
             Re.Multiline = False
         End If
     
       s = ExprStrin.StringBox.value
     
       'Error if string to search is blank
       if s = "" Then
               strError = "<font color=red>Search String cannot be left blank!</font>"
           DataAr1.InnerHTML = strError
           SubAr1.InnerHTML = strError
           strError = ""
     
       ' Test regex if string is not blank
       else
     
           'If a match is found...
           if Re.Test(s) then
               'Collect and Output Matches
               Set colMatches = Re.Execute(s)
               counter = 0
               numMatches = colMatches.count
               for each Test in colMatches
                   ReDim Preserve ResultArr(counter + 1)
                   ResultArr(counter) = Test.value
                   counter = counter + 1
               next
               dim tempstring
               for count2 = 0 to counter - 1
                   tempstring = tempstring & "<b>Match " & count2+1 & ": </b>" & ResultArr(count2) & "<br>"
               next
               DataAr1.InnerHTML = "<b>The following matches were found:</b><br>" & tempstring
     
               'Collect SubMatches and Store them in a String
               subMatchesString = ""
               For i=0 to numMatches-1    'Loop through each match
                   Set myMatch = colMatches(i)
                   numSubMatches = myMatch.submatches.count
                   If numSubMatches > 0 Then    'Loop through each submatch in current match
                       subMatchesString = subMatchesString & "<b>Submatches for Match " & i+1 & "</b><br>"
                       For j=0 to numSubMatches-1
                           subMatchesString = subMatchesString & myMatch.SubMatches(j) & "<br>"
                       Next
                   End If
               Next
     
               'Output submatches to correct field
               SubAr1.InnerHTML = subMatchesString
     
           'If no match is found output error and sub strings
           else
               DataAr1.InnerHTML = "No match was found for the regular expression."
               'ClearSubs
           end if
       end if
     end if
     
     'Clear things up
     Set Re = Nothing
     Set colMatches = nothing
     end sub
     
     'Sub to Run when Clear Results and submatches when button is pressed 
     sub ClearDataAr1
         DataAr1.InnerHTML = "Results Cleared!"
         SubAr1.InnerHTML = "Results Cleared!"
     end sub
     
     
     sub loadfiles
        retVal = "<input type=file name=xmlname> <br> <input type=button value=Assimilate onclick=fileLoader Title=""Click to load settings into App"">"
         Loader.InnerHTML = retVal
         ExprStrin.Saver.disabled = True
         ExprStrin.Templ2.Disabled = True
         exprstrin.xmlname.style.backgroundcolor = "C0C0C0"
     end sub 
     
     sub CloseFile
         Loader.InnerHTML = ""
         Loader2.InnerHTML = ""
         ExprStrin.Loader.Disabled = False
         ExprStrin.Saver.disabled = False
         ExprStrin.Templ2.Disabled = false
     end sub
     
     sub fileLoader
        set fileObj = CreateObject("Scripting.FileSystemObject")
         if ExprStrin.xmlname.value = "" then
            Loader2.InnerHTML= "<font color=red>Enter a filename</font>"
         else
             file = ExprStrin.xmlname.value
         end if 
         if fileObj.FileExists(file) then 
             set objStream = fileObj.OpenTextFile (file, _
             1,false,0)
             opened = true 
         else 
             Loader2.InnerHTML= "<font color=red size=+1>File not found</font>"
             opened = false
         end if
         if opened then
             Loader2.InnerHTML= ""
             contents = ObjStream.Readall
             contents2 = split(contents,"-------")
             expr = Replace(contents2(0),VbnewLine,"")
             if instr(len(contents2(1))-1,contents2(1),vbnewline) then
                 stringer = Left(cstr(contents2(1)),len(cstr(contents2(1)))-2)
                 stringer = right(stringer,len(stringer) -2 )
             else
                 Stringer = contents2(1)
             end if
             ig = Replace(contents2(2),vbnewline,"")
            gs = Replace(contents2(3),vbnewline,"")
             ml = Replace(contents2(4),vbnewline,"")
     
            BoolOpts = CheckBData(ig,gs,ml)
            if  len(BoolOpts) > 0 then
                Loader2.InnerHTML = BoolOpts
                expr =""
                stringer = ""
                ig = ""
                gs = ""
                ml = ""
            else
                'Set hta vars back to loaded values
                 ExprStrin.TextBox.value = expr
                 ExprStrin.StringBox.value = Stringer
                ExprStrin.caseCheckbox.checked = ig     
                ExprStrin.GlobalCheckBox.Checked = gs
                ExprStrin.MultilineCheckBox.checked = ml
            end if
         end if 
        set fileObj = Nothing
     End sub
     
     Function CheckBdata (Ignore,Global,Multi)
        'msgbox Instr(1,ignore,"t",1) & " , " & Instr(1,ignore,"f",1)
        if Instr(1,Ignore,"t",1) > 0 and Instr(1,Ignore,"f",1) > 0 then
            retval = "Ignore case value is not boolean <br>"
        end if 
     
        if Instr(1,Global,"t",1) > 0 and Instr(1,Global,"f",1) > 0 then
            retval = retval & "Global search value is not boolean <br>"
        end if 
     
        if Instr(1,Multi,"t",1) > 0 and Instr(1,Multi,"f",1) > 0 then
            retval = retval & "Multi-line  value is not boolean <br>"
        end if 
     
        if len(retval) > 0 then 
            retval = "<font color=red>" & retval & "</font>"
        end if
        CheckBdata = Retval
     End function
     
     
     sub TmpInner
     Loader2.InnerHTML = ""
     Loader.InnerHTML= "Enter a filename for template<br>" & _
                       "<input type=""Text"" ""id=Templ"" name=""Templ"" value="""">" & _
                       "<input type=""Button"" value=""Save"" onClick=""SaveTmpl"" Title=""Click after entering filename for template to be created"">"
     ExprStrin.Loader.Disabled = true
     ExprStrin.Saver.disabled = true
     ExprStrin.Templ.style.backgroundcolor = "C0C0C0"
     
     end sub 
     
     sub SaveTmpl
     set fileObj = CreateObject("Scripting.FileSystemObject")
     file = ExprStrin.Templ.value 
     if file = "" then 
         Loader2.InnerHTML = "<font color=red size=+1>Enter a FileName</font>"
     else
         if not (fileObj.FileExists(file)) then
             Loader2.InnerHTML = "File not found. Creating now"
             set file2 = fileObj.CreateTextFile(file)
         else 
             Result = msgbox ("Would you like to over-write the file?",33,"Over-write file prompt")
            if Result = vbOK then
                Loader2.InnerHTML = "Over-writing now!"
                 set file2 = fileObj.CreateTextFile(file,True)
                file2.writeline ("'Remove this line and put regular expression here")
                 file2.WriteLine ("-------")
                 file2.WriteLine ("'Remove this line and enter in string.. Can be multi line")
                 file2.WriteLine ("-------")
                 file2.WriteLine ("'Remove this line. Enter boolean of Ignore case value")
                 file2.WriteLine ("-------")
                 file2.WriteLine ("'Remove this line. Enter boolean of Global Search value ")
                 file2.WriteLine ("-------")
                 file2.WriteLine ("'Remove this line. Enter boolean of Multi-Line value")
                 file2.close
            elseif Result = vbCancel then 
                Loader2.InnerHTML = "File existed. File operation canceled"
            end if
         end if 
     
     end if
     set fileObj = nothing
     end sub
     
     sub SaveSets
     Loader2.InnerHTML = ""
     'load txtbox for save value 
     Loader.InnerHTML= "Enter a filename to save<br>" & _
                       "<input type=""Text"" ""id=Templ"" name=""Templ"" value="""">"  & _
                       "<input type=""button"" value=""Save"" onclick=""SaveSets2"" Title=""Click after entering a filename to save"">"
     ExprStrin.Loader.Disabled = True    
     ExprStrin.Templ2.Disabled = True
     ExprStrin.Templ.style.backgroundcolor = "C0C0C0"
     end sub
     
     sub SaveSets2
        set fileObj = CreateObject("Scripting.FileSystemObject")
        file = ExprStrin.Templ.value 
        'open file for writing
         if file = "" then 
             Loader2.InnerHTML = "<font color=red size=+1>Enter a FileName</font>"
         else
             if not (fileObj.FileExists(file)) then 
                 Loader2.InnerHTML = "File not found. Creating now"
                 set file2 = fileObj.CreateTextFile(file)
             else 
                 Result = msgbox ("Would you like to over-write the file?",33,"Over-write file prompt")
                if Result = vbOK then
                     Loader2.InnerHTML = "Over-writing now!"
                     set file2 = fileObj.CreateTextFile(file,True)
                    delim = "-------"
                    file2.writeline(ExprStrin.TextBox.value)
                    file2.writeline(delim)
                    file2.writeline(ExprStrin.StringBox.value)
                    file2.writeline(delim)
                    file2.writeline( ExprStrin.caseCheckbox.checked)
                    file2.writeline(delim)
                    file2.writeline(ExprStrin.GlobalCheckBox.Checked)
                    file2.writeline(delim)
                    file2.writeline(ExprStrin.MultilineCheckBox.checked)
                     file2.close
                elseif Result = vbCancel then 
                    Loader2.InnerHTML = "File existed. File operation canceled"
                end if
            end if 
        End if 
        set fileObj = nothing
     end sub
     
     sub Window_onload
     ExprStrin.TextBox.style.backgroundcolor = "C0C0C0"
     ExprStrin.StringBox.style.backgroundcolor = "c2c2c2"
     end sub
     '#################### End VBScript Section ####################
     </script>
     </head>
     <body STYLE="filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#c2c2c2', EndColorStr='#00CCFF')">
     <form action="some_form_handler.asp" method="post" id="ExprStrin" name="ExprStrin" target="_self">
     <center><h1>Regex Tester</font></h1></center>
       <table align="center">
     
           <tr>
               <td>Enter an expression</td>
               <td><input type="text" id="TextBox" name="TextEntry" value="" tabindex=1 size=66 title="Enter a valid regular expression here"></td>
           </tr>
           <tr>
               <td>Enter a string</td>
               <td><textarea cols=50 rows=4 name="StringBox" tabindex=2 Title="Enter in a string to test Regular expression against"></textarea>
               </td>
           </tr>
       </table>
         <!-- Check boxes and main button locations -->
       <table align="center" cellpadding="5">
           <tr>
               <td><input type=checkbox name="IgnoreCase" ID="CaseCheckBox" tabindex=3 title="Allows the ability to ignore case sensitivity">Ignore Case</td>
               <td><input type=checkbox name="Global" id="GlobalCheckBox" tabindex=4 checked="true" Title="Allows the ability to search the whole string">Global Search</td>
               <td><input type=checkbox name="Multiline" id="MultilineCheckBox" tabindex=5 title="Allows the ability to search multiple line strings">Multiline</td>
               </tr>
               <tr>
               <td><input type="button" value="Clear Results" onClick="ClearDataAr1" size=30 tabindex=6 Title="Clear the results area"></td>
               <td><input type="button" value="Test RegEx" onClick="cmdTextBox" tabindex=7 title="Test regular expression"></td>
               <td><input type = "BUTTON" value = "Reload" onclick = "reloadHTA()"tabindex=8 title="Reload App with default values" ></td>
           </tr>
       </table>
     
       <table align="center" cellpadding="5">
           <tr>
               <td><br><font color=blue size=+1><b>Error or Result display</b></font></td>
           </tr>
       </table>
       <table align="center" >
           <tr>
               <td><span id=DataAr1>Result will display here</span></td>
           </tr>
       </table>
       <table align="center" ID="Table1" cellpadding="5">
           <br>
           <tr><td><font color=blue size=+1><b>Substring Matches Display</b></font></td></tr>
       </table>
       <table align=center >
           <tr>
               <td><span id=SubAr1>Substrings will display here</span></td>
           </tr>
       </table>
       <table align=center cellpadding="5"><br><br>
         <tr>
             <td><font color=blue size=+1>Import/Export data from file</font><br><input type="button" value="Load" onClick="loadfiles" id="loader" Title="Select to enable loading options">
                 <input type="button" value="Template" onClick="TmpInner" id="Templ2" Title="Allows the creation of a default template">
                 <input type="button" value="Save" onclick="SaveSets" id="Saver" Title="Allows you to save current settings to a file">
                 <input type="button" Value="Hide" onClick="CloseFile" Title="Hides save/template options"></td>
       </tr>
         <tr>
         <td><span id=Loader></span></td>
         </tr>
         <tr><td><span id=Loader2></span></td></tr>
     </table>
     </form>
     </body>
     </html>

  8. #8
    Membre averti
    Femme Profil pro
    Inscrit en
    Mars 2013
    Messages
    16
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France

    Informations forums :
    Inscription : Mars 2013
    Messages : 16
    Par défaut
    Merci beaucoup Mehdi Tounisiano pour les liens.

    Pour la dernière réponse c'est bien comme code(une belle interface).
    Mais comment puis-je l'introduire avec mon code VBScript(en .vbs) ?

    Merci d'avance

  9. #9
    Expert confirmé
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 844
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 844
    Par défaut

    testez ce code : AdressesIP.hta avec la possibilité de récupérer l'adresse IP publique et j'attends vos "my sweet honey"
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    <html>
    <head>
    <title>Application pour Tester la Connexion à Internet avec affichage des adresses IP(s) © Hackoo  2013 (^_^)</title>
    <HTA:APPLICATION 
    APPLICATIONNAME="Set IP config"
    SCROLL="no"
    SINGLEINSTANCE="yes"
    ICON="nslookup.exe"
    MAXIMIZEBUTTON="no"
    WINDOWSTATE="no">
    </head>
    <META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
    <script language="VBScript">
    Dim TimerID,vbtxt
    Dim refresh
    VBtxt="Application pour Tester la Connexion à Internet avec affichage des adresses IP(s) © Hackoo  2013 (^_^) "
    VBvitesse="500"
     
    Sub IPs()
        Set oFso = CreateObject("Scripting.FileSystemObject")
        If oFso.FileExists("c:\ipconfig.txt") Then
            Set f = oFso.OpenTextFile("c:\ipconfig.txt",1)
            Data = f.ReadAll
            f.Close
        Else
            MsgBox "une erreur s'est produite lors de la lecture du fichier c:\ipconfig.txt",16,"Erreurde Lecture du fichier"
            Exit Sub
        End If
        Set objRegex = new RegExp
        objRegex.Pattern = "\b((25[0-5]|2[0-4]\d|1?\d?\d)\.){3}(25[0-5]|2[0-4]\d|1?\d?\d)\b"
        objRegex.Global = True
        objRegex.IgnoreCase = True
        Set Matches = objRegex.Execute(Data)
    'MsgBox Matches(0)&vbcr&Matches(1)&vbcr&Matches(2)
        IPaddress.Value = Matches(0)
        Subnet.Value=Matches(1)
        Gateway.Value=Matches(2)
    End Sub
     
    Function VBScroll_Title()
        Document.title=vbtxt 
        vbtxt=mid(vbtxt,2,len(vbtxt)) & left(vbtxt,1)
    End Function
     
    Sub stoper() 
        Clear=ClearInterval(refresh)
    End Sub
     
    Sub Window_OnLoad
        CenterWindow 320,300
        refresh=setInterval("VBscroll_title()",VBvitesse,"Vbscript")
        IpConfig()
        IPs()
    End Sub
     
    Sub IpConfig()
        Set Ws = CreateObject("wscript.Shell")
        Command = "Cmd /c ipconfig > c:\ipconfig.txt"
        Resultat = Ws.Run(Command,0,True)
    End Sub
     
    Sub CheckIP()
        Dim IP,Masque,Passerelle,DNS1,DNS2
        IP = IPaddress.Value 
        Masque = Subnet.Value
        Passerelle = Gateway.Value
        DNS1 = DNSServer1.Value
        DNS2 = DNSServer2.Value
     
        If Not IP_Valide(IP) Then
            MsgBox "L'adresse IP que vous avez saisi est non valide",16,"L'adresse IP que vous avez saisi est non valide"
            IPaddress.Focus()
        End If
     
        If Not IP_Valide(Masque) Then
            MsgBox "L'adresse IP du masque sous-réseau que vous avez saisi est non valide",16,"L'adresse IP du masque sous-réseau que vous avez saisi est non valide"
            Subnet.Focus()
        End If
     
        If Not IP_Valide(Passerelle) Then
            MsgBox "L'adresse IP de la Passerelle par défaut que vous avez saisi est non valide",16,"L'adresse IP de la Passerelle par défaut que vous avez saisi est non valide"
            Gateway.Focus()
        End If
     
        If Not IP_Valide(DNS1) Then
            MsgBox "L'adresse IP de DNS1 que vous avez saisi est non valide",16,"L'adresse IP de DNS1 que vous avez saisi est non valide"
            DNSServer1.Focus()
        End If
     
        If Not IP_Valide(DNS2) Then
            MsgBox "L'adresse IP de DNS2 que vous avez saisi est non valide",16,"L'adresse IP de DNS2 que vous avez saisi est non valide"
            DNSServer2.Focus()
        End If 
     
        If IP_Valide(IP) And IP_Valide(Masque) And IP_Valide(Passerelle) And IP_Valide(DNS1) And IP_Valide(DNS2) Then
            MsgBox "IP : "&IP&vbCr&"Masque sous réseau : "&Masque&vbCr&"Passerelle par défaut : "&Passerelle&vbCr&_
            "DNS1 : "& DNS1&vbCr&"DNS2 : "& DNS2,64,"Les @ IP"
        End If
    End Sub
     
    Sub CenterWindow(x,y)
        window.resizeTo x, y
        iLeft = window.screen.availWidth/2 - x/2
        itop = window.screen.availHeight/2 - y/2
        window.moveTo ileft, itop
    End Sub
     
    Function IP_Valide(ip)
        Set RegularExpressionObject = New RegExp
        With RegularExpressionObject
            .Pattern = "\b((25[0-5]|2[0-4]\d|1?\d?\d)\.){3}(25[0-5]|2[0-4]\d|1?\d?\d)\b"
            .IgnoreCase = False
            If .Test(ip)= True then
                IP_Valide = True
            end if
        End With
    End Function
     
    Function TestConnexion()
        strComputer = "smtp.gmail.com"
        Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
        For Each objStatus in objPing
            If objStatus.Statuscode = 0 Then
                TestConnexion = True
                Call stoper
                Self.document.title = "Connecté à INTERNET © Hackoo"
                Ip_Publique
            Else
                TestConnexion = False
                Call Stoper
                Self.document.title = "PAS Connecté A INTERNET © Hackoo"
                ip.InnerHTML = "###.###.###.###"
            end If    
        Next    
    End Function
     
    Sub Ip_Publique
        Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches
        Titre = "Adresse Ip Publique !"
        URL = "http://monip.org"
        Set ie = CreateObject("InternetExplorer.Application")
        Set objFSO = CreateObject("Scripting.FileSystemObject") 
        ie.Navigate (URL) 
        ie.Visible=false
        DO WHILE ie.busy
            Sleep 100
        LOOP
        Data = ie.document.documentElement.innertext 
        ie.Quit 
        Set ie = Nothing
        Set objRegex = new RegExp
        objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"
        objRegex.Global = False
        objRegex.IgnoreCase = True
        Set Matches = objRegex.Execute(Data)
        For Each Match in Matches   
            ip.InnerHTML = Match.Value
        Next
    End Sub
     
    Sub Sleep(MSecs)' Fonction pour faire une pause car wscript.sleep ne marche pas dans un HTA 
        Set fso = CreateObject("Scripting.FileSystemObject")
        Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
        Dim tempName : tempName = "Sleeper.vbs"
        If Fso.FileExists(tempFolder&"\"&tempName)=False Then
            Set objOutputFile = fso.CreateTextFile(tempFolder&"\"&tempName, True)
            objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
            objOutputFile.Close
        End If
        CreateObject("WScript.Shell").Run tempFolder&"\"&tempName &" "& MSecs,1,True
    End Sub
    </script>
    <body STYLE="font:10 pt arial; color:white;
    filter:progid:DXImageTransform.Microsoft.Gradient
    (GradientType=1, StartColorStr='#000000', EndColorStr='#0000FF')">
    <table>
    <tr><a><B>IP Publique : </B><B><font color="#669933"><span id="ip"></span></font></B></a><p></tr>
    <tr>
    <td><B>Adresse IP Locale</B></td>
    <td>
    <input type="textbox" name="IPaddress" size="13"  style="font-weight: bold">
    </td>
    </tr>
    <tr>
    <td><B>Masque sous-réseau</B></td>
    <td>
    <input type="textbox" name="Subnet" size="13"  style="font-weight: bold">
    </td>
    </tr>
    <tr>
    <td><B>Passerelle par défaut</B></td>
    <td>
    <input type="textbox" name="Gateway" size="13"  style="font-weight: bold">
    </td>
    </tr>
    <tr>
    <td><B>DNS Server 1</B></td>
    <td>
    <input type="textbox" name="DNSServer1" size="13"  style="font-weight: bold">
    </td>
    </tr>
    <tr>
    <td><B>DNS Server 2</B></td>
    <td>
    <input type="textbox" name="DNSServer2" size="13"  style="font-weight: bold">
    </td>
    </tr>
    </table><br>
    <center><input type="Submit" style="cursor:hand;" value="Vérifier les @IP" name="Check"  onClick="CheckIP()" style="font-weight: bold">
    <input type="button" style="cursor:hand;" value="IP Publique" name="Reload"  onClick="TestConnexion()" style="font-weight: bold"><p> 
    </body>
    </html>

  10. #10
    Rédacteur
    Avatar de omen999
    Profil pro
    Inscrit en
    Février 2006
    Messages
    1 302
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2006
    Messages : 1 302
    Par défaut
    bonjour,
    pour faciliter le contrôle des données IP en donnant au champ un aspect pro il faut s'inspirer de cet exemple (celui de SpaceFrog )
    bien évidemment, cela ne dispense pas de l'étape contrôle des données (numérique entre 0 et 255) pour chacun des trois champs
    nomen omen, nemo non omen - Consultez la FAQ VBScript et les cours et tutoriels VBScript
    le plus terrible lorsqu'une voiture renverse un piéton, c'est que ce sont les freins qui hurlent. (ramón)
    pas de questions techniques par mp

  11. #11
    Membre averti
    Femme Profil pro
    Inscrit en
    Mars 2013
    Messages
    16
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Localisation : France

    Informations forums :
    Inscription : Mars 2013
    Messages : 16
    Par défaut
    Merci beaucoup à vous. Mais je répète encore ma question:

    Comment puis-je introduire ce code dans mon code déjà existant en extension (.vbs).

    Merci pour votre aide

  12. #12
    Expert confirmé
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 844
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 844
    Par défaut

    une petite tentative en tenant compte de la remarque de Omen999 et sans validation des adresses IP, juste la partie graphique
    BoiteSaisieIP.hta
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    <html>
    <HTA:APPLICATION 
    APPLICATIONNAME="Set IP config"
    SCROLL="no"
    SINGLEINSTANCE="yes"
    ICON="nslookup.exe"
    MAXIMIZEBUTTON="no"
    WINDOWSTATE="no">
    <style type='text/css'>
    input {width:21px;
    border:0px;
    font-size:10px;
    background-color:lightcyan;
    font-weight:bold;
    text-align:center;
    }
    BODY {background:lightcyan;} 
     
    .button {
    border-size: 0px;
    border-style: none;
    background: inherit;
    width: 120px;
    font-size:14px;
    color: blue;
    cursor: hand;
    cursor: pointer;
    padding: 0px;
    }
    </style>
    </head>
    <title>Saisie des adresses IP</title>
    <META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
    <script language="VBScript">
     
    Sub Window_OnLoad
        CenterWindow 320,350
    End Sub
     
    Sub CenterWindow(x,y)
        window.resizeTo x, y
        iLeft = window.screen.availWidth/2 - x/2
        itop = window.screen.availHeight/2 - y/2
        window.moveTo ileft, itop
    End Sub
    </script>
    <body>
    <fieldset>
    <legend>Utiliser l'adresse IP suivante</legend>
    <table>
    <tr>
    <td><p style="float:left"><B>Adresse IP Locale :</B></p></td>
    <td><div style="border:solid 1px gray;width:100px;"><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" />
    </div></td>
    </tr>
     
    <tr>
    <td><p style="float:left"><B>Masque sous-réseau :</B></p></td>
    <td><div style="border:solid 1px gray;width:100px;"><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" />
    </div></td>
    </tr>
     
    <tr>
    <td><p style="float:left"><B>Passerelle par défaut :</B></p></td>
    <td><div style="border:solid 1px gray;width:100px;"><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" />
    </div></td>
    </tr>
    </table>
    </fieldset>
    <br>
    <fieldset>
    <legend>Utiliser l'adresse DNS suivante </legend>
    <table>
    <tr>
    <td><p style="float:left"><B>Serveur DNS N° 1 : &nbsp;&nbsp;&nbsp;&nbsp;</B></p></td>
    <td><div style="border:solid 1px gray;width:100px;"><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" />
    </div></td>
    </tr>
     
    <tr>
    <td><p style="float:left"><B>Serveur DNS N° 2 :&nbsp;&nbsp;&nbsp;&nbsp;</B></p></td>
    <td><div style="border:solid 1px gray;width:100px;"><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" /><b>.</b><input type='text' class="IP" maxLength="3" />
    </div></td>
    </tr>
    </table>
    </fieldset>
    <br>
    <center><input type="Submit" class="button" style="cursor:hand;" value="Vérifier les @IP" name="Check"  onClick="CheckIP()" style="font-weight: bold">
    <input type="button" class="button" style="cursor:hand;" value="IP Publique" name="Reload"  onClick="TestConnexion()" style="font-weight: bold"><p> 
    <body>
    </html>

  13. #13
    Rédacteur
    Avatar de omen999
    Profil pro
    Inscrit en
    Février 2006
    Messages
    1 302
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2006
    Messages : 1 302
    Par défaut
    Comment puis-je introduire ce code dans mon code déjà existant en extension (.vbs).
    en s'inspirant de cette technique par exemple
    il existe une technique plus bourrin qui consiste à écrire le code hta sous forme d'un fichier .hta puis de l'exécuter avec un objet "InternetExplorer.Application"
    nomen omen, nemo non omen - Consultez la FAQ VBScript et les cours et tutoriels VBScript
    le plus terrible lorsqu'une voiture renverse un piéton, c'est que ce sont les freins qui hurlent. (ramón)
    pas de questions techniques par mp

  14. #14
    Expert confirmé
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 844
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 844
    Par défaut

    Il s'agit d'une nouvelle version avec l'erreur clignotante en rouge pour valider l'IP saisie comme elle est tapé


Discussions similaires

  1. Réponses: 4
    Dernier message: 07/07/2009, 13h29
  2. Réponses: 3
    Dernier message: 19/02/2009, 16h26
  3. boite de dialogue pour une sauvegarde
    Par ludosnip dans le forum VBA Access
    Réponses: 1
    Dernier message: 16/02/2009, 19h08
  4. [A-03]Ouvrir une boite de dialogue pour selectionner un fichier
    Par Milyshyn76 dans le forum VBA Access
    Réponses: 3
    Dernier message: 16/10/2008, 14h26
  5. [Débutant] Ouvrir une boite de dialogue pour enregistrer un fichier
    Par pompier21 dans le forum Interfaces Graphiques
    Réponses: 2
    Dernier message: 09/10/2008, 10h09

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo