VBscript: Boite de dialogue pour saisir une @ IP

Version imprimable

27/03/2013, 11h56
honey2

1 pièce(s) jointe(s)

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:

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
27/03/2013, 13h32
hackoofr

:salut: 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 :koi:
27/03/2013, 15h28
honey2

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

:salut:
un début de script avec test de validité de l'adresse ip saisi par l’utilisateur :pc:
Exemple :

Citation:

172.16.18.21 est une adresse ip Valide :king:
300.22.194.37 est une adresse ip non Valide :nono:

Code:

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

28/03/2013, 14h06
honey2

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
29/03/2013, 10h04
hackoofr

Citation:

Envoyé par honey2

Peux tu m'expliquer un peu plus en détail le fonctionnement de la fonction IP_Valide(ip)?

D'après la :faq: Comment tester une chaîne de caractères avec une expression régulière ?

un tutoriel sur les expressions régulières

Bonne lecture :king:

:salut: 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 :king:

Code:

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>

03/04/2013, 14h39
honey2

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

:salut:
testez ce code : AdressesIP.hta avec la possibilité de récupérer l'adresse IP publique :king: et j'attends vos :plusser: "my sweet honey" ;) :zoubi: :mouarf:

Code:

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>

04/04/2013, 10h59
omen999

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 :roll:)
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
04/04/2013, 17h13
honey2

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

:salut:
une petite tentative en tenant compte de la remarque de Omen999 et sans validation des adresses IP, juste la partie graphique :king:
BoiteSaisieIP.hta

Code:

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>

04/04/2013, 18h04
omen999

Citation:

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"
08/04/2013, 22h04
hackoofr

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

[HTA] Boîte de saisie avec contrôle de validité d'adresses IP