[HTA] Text box control with valid IP addresses 1

crackoo · Apr 4, 2013

Hi

I'm a bit tired and I can not find my mistake perhaps it is so simple but a little help on your part is required
Well, I want to check the validity of IP addresses entered by the user, but I do not recover when I want to do a concatenation like this :

Code:

Dim IP
Dim Masque
Dim Passerelle
Dim DNS1
Dim DNS2
    IP = N1.Value &"."& N2.Value &"."& N3.Value &"."& N4.Value 
    Masque = N5.Value &"."& N6.Value &"."& N7.Value &"."& N8.Value
    Passerelle = N9.Value &"."& N10.Value &"."& N11.Value &"."& N12.Value
    DNS1 = N13.Value &"."& N14.Value &"."& N15.Value &"."& N16.Value
    DNS2 = N17.Value &"."& N18.Value &"."& N19.Value &"."& N20.Value

The Hole HTA

Code:

<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">
Dim IP
Dim Masque
Dim Passerelle
Dim DNS1
Dim DNS2
    IP = N1.Value &"."& N2.Value &"."& N3.Value &"."& N4.Value 
	Masque = N5.Value &"."& N6.Value &"."& N7.Value &"."& N8.Value
	Passerelle = N9.Value &"."& N10.Value &"."& N11.Value &"."& N12.Value
	DNS1 = N13.Value &"."& N14.Value &"."& N15.Value &"."& N16.Value
	DNS2 = N17.Value &"."& N18.Value &"."& N19.Value &"."& N20.Value
	
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

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

Sub CheckIP()
	If Not IP_Valide(IP) Then
	MsgBox IP
		MsgBox "L'adresse IP que vous avez saisi "&IP&vbcr&" est non valide",16,"L'adresse IP que vous avez saisi est non valide"
		N1.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"
		MsgBox Masque
		N2.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"
		N3.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"
		N4.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"
		N5.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

</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" name="N1" /><b>.</b><input type='text' class="IP" maxLength="3" name="N2"/><b>.</b><input type='text' class="IP" maxLength="3" name="N3"/><b>.</b><input type='text' class="IP" maxLength="3" name="N4" />
</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" name="N5" /><b>.</b><input type='text' class="IP" maxLength="3" name="N6" /><b>.</b><input type='text' class="IP" maxLength="3" name="N7"/><b>.</b><input type='text' class="IP" maxLength="3" name="N8" />
</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" name="N9" /><b>.</b><input type='text' class="IP" maxLength="3" name="N10"/><b>.</b><input type='text' class="IP" maxLength="3" name="N11" /><b>.</b><input type='text' class="IP" maxLength="3" name="N12" />
</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" name="N13" /><b>.</b><input type='text' class="IP" maxLength="3" name="N14" /><b>.</b><input type='text' class="IP" maxLength="3" name="N15" /><b>.</b><input type='text' class="IP" maxLength="3" name="N16" />
</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" name="N17" /><b>.</b><input type='text' class="IP" maxLength="3" name="N18" /><b>.</b><input type='text' class="IP" maxLength="3" name="N19" /><b>.</b><input type='text' class="IP" maxLength="3" name="N20" />
</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>

Thank you !

Geates · Apr 5, 2013

Your code is referencing elements that don't exist in the DOM yet (N1.value, N2.Value...) - I'd put the code in question inside the CheckIP sub.

-Geates

http://ns7.webmasters.com/caspdoc/html/vbscript_language_reference.htm

crackoo · Apr 5, 2013

Thank you Geates for your remark and the problem is solved like this [2thumbsup]

Code:

<html>
<HTA:APPLICATION 
APPLICATIONNAME="Set IP config"
SCROLL="no"
ICON="nslookup.exe"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="no"
CAPTION="yes"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="yes"
SYSMENU="yes"
BORDER="thin"
BORDERSTYLE="Normal"
CONTEXTMENU="no"
SELECTION="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" defer=true>
Sub Window_OnLoad
    CenterWindow 320,360
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
 
Sub CheckIP()
Dim IP
Dim Masque
Dim Passerelle
Dim DNS1
Dim DNS2
    IP = N1.Value &"."& N2.Value &"."& N3.Value &"."& N4.Value 
    Masque = N5.Value &"."& N6.Value &"."& N7.Value &"."& N8.Value
    Passerelle = N9.Value &"."& N10.Value &"."& N11.Value &"."& N12.Value
    DNS1 = N13.Value &"."& N14.Value &"."& N15.Value &"."& N16.Value
    DNS2 = N17.Value &"."& N18.Value &"."& N19.Value &"."& N20.Value
    If Not IP_Valide(IP) Then
    MsgBox IP
        MsgBox "L'adresse IP que vous avez saisi "&IP&vbcr&" est non valide",16,"L'adresse IP que vous avez saisi est non valide"
        N1.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"
        MsgBox Masque
        N2.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"
        N3.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"
        N4.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"
        N5.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 Ip_Publique
    Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches
    Titre = "Adresse Ip Publique !"
    URL = "[URL unfurl="true"]http://monip.org"[/URL]
    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_public.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>
<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" name="N1" /><b>.</b><input type='text' class="IP" maxLength="3" name="N2"/><b>.</b><input type='text' class="IP" maxLength="3" name="N3"/><b>.</b><input type='text' class="IP" maxLength="3" name="N4" />
</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" name="N5" /><b>.</b><input type='text' class="IP" maxLength="3" name="N6" /><b>.</b><input type='text' class="IP" maxLength="3" name="N7"/><b>.</b><input type='text' class="IP" maxLength="3" name="N8" />
</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" name="N9" /><b>.</b><input type='text' class="IP" maxLength="3" name="N10"/><b>.</b><input type='text' class="IP" maxLength="3" name="N11" /><b>.</b><input type='text' class="IP" maxLength="3" name="N12" />
</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" name="N13" /><b>.</b><input type='text' class="IP" maxLength="3" name="N14" /><b>.</b><input type='text' class="IP" maxLength="3" name="N15" /><b>.</b><input type='text' class="IP" maxLength="3" name="N16" />
</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" name="N17" /><b>.</b><input type='text' class="IP" maxLength="3" name="N18" /><b>.</b><input type='text' class="IP" maxLength="3" name="N19" /><b>.</b><input type='text' class="IP" maxLength="3" name="N20" />
</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="IP Publique"  onClick="Ip_Publique()" style="font-weight: bold"><p> 
<center><B><font color="#669933"><span id="ip_public"></span></font></B></center>
<body>
</html>

crackoo · Apr 6, 2013

Hi

This is a new version with highlighting error in red color to Validate the IP entered as it is typed [2thumbsup]

Code:

<html>
<HTA:APPLICATION 
APPLICATIONNAME="Set IP config"
SCROLL="no"
ICON="nslookup.exe"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
WINDOWSTATE="no"
CAPTION="yes"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="yes"
SYSMENU="yes"
BORDER="thin"
BORDERSTYLE="Normal"
CONTEXTMENU="no"
SELECTION="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" defer=true>
Sub Window_OnLoad
    CenterWindow 320,360
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

Sub IPCheckN1()
		On Error Resume Next
		If N1.Value > 255 OR IsNumeric(N1.Value) = False  Then
		    N1.style.backgroundcolor = "red"
		    Sleep "1"
			N1.Value = ""
			N1.style.backgroundcolor = "lightcyan"
		End If
		If Len(N1.Value) = 3 OR InStr(N1.Value, ".") > 0 Then
			N1.Value=Replace(N1.Value,".","")
			N2.Focus
			N2.Select
		End If
	End Sub
	
Sub IPCheckN2()
		On Error Resume Next
		If N2.Value > 255 OR IsNumeric(N2.Value) = False  Then
		    N2.style.backgroundcolor = "red"
		    Sleep "1"
			N2.Value = ""
			N2.style.backgroundcolor = "lightcyan"
		End If
		If Len(N2.Value) = 3 OR InStr(N2.Value, ".") > 0 Then
			N2.Value=Replace(N2.Value,".","")
			N3.Focus
			N3.Select
		End If
	End Sub	

Sub IPCheckN3()
		On Error Resume Next
		If N3.Value > 255 OR IsNumeric(N3.Value) = False  Then
		    N3.style.backgroundcolor = "red"
		    Sleep "1"
			N3.Value = ""
			N3.style.backgroundcolor = "lightcyan"
		End If
		If Len(N3.Value) = 3 OR InStr(N3.Value, ".") > 0 Then
			N3.Value=Replace(N3.Value,".","")
			N4.Focus
			N4.Select
		End If
End Sub	
 
Sub IPCheckN4()
		On Error Resume Next
		If N4.Value > 255 OR IsNumeric(N4.Value) = False  Then
		    N4.style.backgroundcolor = "red"
		    Sleep "1"
			N4.Value = ""
			N4.style.backgroundcolor = "lightcyan"
		End If
		If Len(N4.Value) = 3 OR InStr(N4.Value, ".") > 0 Then
			N4.Value=Replace(N4.Value,".","")
			N5.Focus
			N5.Select
		End If
End Sub	

Sub IPCheckN5()
		On Error Resume Next
		If N5.Value > 255 OR IsNumeric(N5.Value) = False  Then
		    N5.style.backgroundcolor = "red"
		    Sleep "1"
			N5.Value = ""
			N5.style.backgroundcolor = "lightcyan"
		End If
		If Len(N5.Value) = 3 OR InStr(N5.Value, ".") > 0 Then
			N5.Value=Replace(N5.Value,".","")
			N6.Focus
			N6.Select
		End If
End Sub	

Sub IPCheckN6()
		On Error Resume Next
		If N6.Value > 255 OR IsNumeric(N6.Value) = False  Then
		    N6.style.backgroundcolor = "red"
		    Sleep "1"
			N6.Value = ""
			N6.style.backgroundcolor = "lightcyan"
		End If
		If Len(N6.Value) = 3 OR InStr(N6.Value, ".") > 0 Then
			N6.Value=Replace(N6.Value,".","")
			N7.Focus
			N7.Select
		End If
End Sub	

Sub IPCheckN7()
		On Error Resume Next
		If N7.Value > 255 OR IsNumeric(N7.Value) = False  Then
		    N7.style.backgroundcolor = "red"
		    Sleep "1"
			N7.Value = ""
			N7.style.backgroundcolor = "lightcyan"
		End If
		If Len(N7.Value) = 3 OR InStr(N7.Value, ".") > 0 Then
			N7.Value=Replace(N7.Value,".","")
			N8.Focus
			N8.Select
		End If
End Sub	
 
Sub IPCheckN8()
		On Error Resume Next
		If N8.Value > 255 OR IsNumeric(N8.Value) = False  Then
		    N8.style.backgroundcolor = "red"
		    Sleep "1"
			N8.Value = ""
			N8.style.backgroundcolor = "lightcyan"
		End If
		If Len(N8.Value) = 3 OR InStr(N8.Value, ".") > 0 Then
			N8.Value=Replace(N8.Value,".","")
			N9.Focus
			N9.Select
		End If
End Sub	

Sub IPCheckN9()
		On Error Resume Next
		If N9.Value > 255 OR IsNumeric(N9.Value) = False  Then
		    N9.style.backgroundcolor = "red"
		    Sleep "1"
			N9.Value = ""
			N9.style.backgroundcolor = "lightcyan"
		End If
		If Len(N9.Value) = 3 OR InStr(N9.Value, ".") > 0 Then
			N9.Value=Replace(N9.Value,".","")
			N10.Focus
			N10.Select
		End If
End Sub	

Sub IPCheckN10()
		On Error Resume Next
		If N10.Value > 255 OR IsNumeric(N10.Value) = False  Then
		    N10.style.backgroundcolor = "red"
		    Sleep "1"
			N10.Value = ""
			N10.style.backgroundcolor = "lightcyan"
		End If
		If Len(N10.Value) = 3 OR InStr(N10.Value, ".") > 0 Then
			N10.Value=Replace(N10.Value,".","")
			N11.Focus
			N11.Select
		End If
End Sub	

Sub IPCheckN11()
		On Error Resume Next
		If N11.Value > 255 OR IsNumeric(N11.Value) = False  Then
		    N11.style.backgroundcolor = "red"
		    Sleep "1"
			N11.Value = ""
			N11.style.backgroundcolor = "lightcyan"
		End If
		If Len(N11.Value) = 3 OR InStr(N11.Value, ".") > 0 Then
			N11.Value=Replace(N11.Value,".","")
			N12.Focus
			N12.Select
		End If
End Sub	
 
Sub IPCheckN12()
		On Error Resume Next
		If N12.Value > 255 OR IsNumeric(N12.Value) = False  Then
		    N12.style.backgroundcolor = "red"
		    Sleep "1"
			N12.Value = ""
			N12.style.backgroundcolor = "lightcyan"
		End If
		If Len(N12.Value) = 3 OR InStr(N12.Value, ".") > 0 Then
			N12.Value=Replace(N12.Value,".","")
			N13.Focus
			N13.Select
		End If
End Sub	

Sub IPCheckN13()
		On Error Resume Next
		If N13.Value > 255 OR IsNumeric(N13.Value) = False  Then
		    N13.style.backgroundcolor = "red"
		    Sleep "1"
			N13.Value = ""
			N13.style.backgroundcolor = "lightcyan"
		End If
		If Len(N13.Value) = 3 OR InStr(N13.Value, ".") > 0 Then
			N13.Value=Replace(N13.Value,".","")
			N14.Focus
			N14.Select
		End If
End Sub	

Sub IPCheckN14()
		On Error Resume Next
		If N14.Value > 255 OR IsNumeric(N14.Value) = False  Then
		    N14.style.backgroundcolor = "red"
		    Sleep "1"
			N14.Value = ""
			N14.style.backgroundcolor = "lightcyan"
		End If
		If Len(N14.Value) = 3 OR InStr(N14.Value, ".") > 0 Then
			N14.Value=Replace(N14.Value,".","")
			N15.Focus
			N15.Select
		End If
End Sub	

Sub IPCheckN15()
		On Error Resume Next
		If N15.Value > 255 OR IsNumeric(N15.Value) = False  Then
		    N15.style.backgroundcolor = "red"
		    Sleep "1"
			N15.Value = ""
			N15.style.backgroundcolor = "lightcyan"
		End If
		If Len(N15.Value) = 3 OR InStr(N15.Value, ".") > 0 Then
			N15.Value=Replace(N15.Value,".","")
			N16.Focus
			N16.Select
		End If
End Sub	

Sub IPCheckN16()
		On Error Resume Next
		If N16.Value > 255 OR IsNumeric(N16.Value) = False  Then
		    N16.style.backgroundcolor = "red"
		    Sleep "1"
			N16.Value = ""
			N16.style.backgroundcolor = "lightcyan"
		End If
		If Len(N16.Value) = 3 OR InStr(N16.Value, ".") > 0 Then
			N16.Value=Replace(N16.Value,".","")
			N17.Focus
			N17.Select
		End If
End Sub	

Sub IPCheckN17()
		On Error Resume Next
		If N17.Value > 255 OR IsNumeric(N17.Value) = False  Then
		    N17.style.backgroundcolor = "red"
		    Sleep "1"
			N17.Value = ""
			N17.style.backgroundcolor = "lightcyan"
		End If
		If Len(N17.Value) = 3 OR InStr(N17.Value, ".") > 0 Then
			N17.Value=Replace(N17.Value,".","")
			N18.Focus
			N18.Select
		End If
End Sub	

Sub IPCheckN18()
		On Error Resume Next
		If N18.Value > 255 OR IsNumeric(N18.Value) = False  Then
		    N18.style.backgroundcolor = "red"
		    Sleep "1"
			N18.Value = ""
			N18.style.backgroundcolor = "lightcyan"
		End If
		If Len(N18.Value) = 3 OR InStr(N18.Value, ".") > 0 Then
			N18.Value=Replace(N18.Value,".","")
			N19.Focus
			N19.Select
		End If
End Sub	

Sub IPCheckN19()
		On Error Resume Next
		If N19.Value > 255 OR IsNumeric(N19.Value) = False  Then
		    N19.style.backgroundcolor = "red"
		    Sleep "1"
			N19.Value = ""
			N19.style.backgroundcolor = "lightcyan"
		End If
		If Len(N19.Value) = 3 OR InStr(N19.Value, ".") > 0 Then
			N19.Value=Replace(N19.Value,".","")
			N20.Focus
			N20.Select
		End If
End Sub	

Sub IPCheckN20()
		On Error Resume Next
		If N20.Value > 255 OR IsNumeric(N20.Value) = False  Then
		    N20.style.backgroundcolor = "red"
		    Sleep "1"
			N20.Value = ""
			N20.style.backgroundcolor = "lightcyan"
		End If
		If Len(N20.Value) = 3 OR InStr(N20.Value, ".") > 0 Then
			N20.Value=Replace(N20.Value,".","")
			Check.Focus
			Check.Select
		End If
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
 
Sub CheckIP()
Dim IP
Dim Masque
Dim Passerelle
Dim DNS1
Dim DNS2
    IP = N1.Value &"."& N2.Value &"."& N3.Value &"."& N4.Value 
    Masque = N5.Value &"."& N6.Value &"."& N7.Value &"."& N8.Value
    Passerelle = N9.Value &"."& N10.Value &"."& N11.Value &"."& N12.Value
    DNS1 = N13.Value &"."& N14.Value &"."& N15.Value &"."& N16.Value
    DNS2 = N17.Value &"."& N18.Value &"."& N19.Value &"."& N20.Value
 
    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"
        Else
        MsgBox "Attention ! la saisie des adresses IP ne sont pas valides !",16,"Attention ! la saisie des adresses IP ne sont pas valides !"
    End If
End Sub
 
Sub Ip_Publique
    Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches
    Titre = "Adresse Ip Publique !"
    URL = "[URL unfurl="true"]http://monip.org"[/URL]
    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_public.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>
<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" onKeyUp="IPCheckN1()" name="N1" /><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN2()"name="N2"/><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN3()" name="N3"/><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN4()" name="N4" />
</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" onKeyUp="IPCheckN5()" name="N5" /><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN6()" name="N6" /><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN7()" name="N7"/><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN8()" name="N8" />
</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" onKeyUp="IPCheckN9()" name="N9" /><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN10()" name="N10"/><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN11()" name="N11" /><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN12()" name="N12" />
</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" onKeyUp="IPCheckN13()" name="N13" /><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN14()" name="N14" /><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN15()" name="N15" /><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN16()" name="N16" />
</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" onKeyUp="IPCheckN17()" name="N17" /><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN18()" name="N18" /><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN19()" name="N19" /><b>.</b><input type='text' class="IP" maxLength="3" onKeyUp="IPCheckN20()" name="N20" />
</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="PublicIP"  onClick="Ip_Publique()" style="font-weight: bold"><p> 
<center><B><font color="#669933"><span id="ip_public"></span></font></B></center>
<body>
</html>

Geates · Apr 8, 2013

I want to bring to your attention a couple of observations that you may what to investigate.

1. Although a clever work around, your sleep function is inaccurate. You need to consider the time it takes the code to generate the objects and files necessary for this function to work properly. For example, a sleep for 100 millisecs resulted in 148 execution time. Of course, as your delay approaches infinite, the inaccurracy is lessened - although, I don't know of many programs that have an infinite delay.

Code:

<html>
<script language = "vbscript">
	Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
	Dim tempName : tempName = "Sleeper.vbs"
	Dim strSleeper : strSleeper = tempFolder & "\" & tempName

	Set fso = CreateObject("Scripting.FileSystemObject")
	set objShell = CreateObject("WScript.Shell")

	Set objOutputFile = fso.OpenTextFile(strSleeper, 2, True, 0)
	objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
	objOutputFile.Close

	Sub Sleep(MSecs)' Fonction pour faire une pause car wscript.sleep ne marche pas dans un HTA
		[highlight #FCE94F]dblStart = cdbl(timer)[/highlight]
		objShell.Run strSleeper & " "& MSecs,1,True
		[highlight #FCE94F]dblEnd = cdbl(timer)[/highlight]
		[highlight #FCE94F]result.innerHTML = formatNumber((dblEnd - dblStart), 4, true, true)[/highlight]
	End Sub
    </script>

    [highlight #FCE94F]<button onClick="sleep(100)">click</button>[/highlight]
    [highlight #FCE94F]<span id="result"></span>[/highlight]
</html>

Because the content never changes, you could improve it a bit by creating the sleeper.vbs script once at the beginning of the HTA. However, the accuracy gained is marginal (9% in my example) as the bulk of the inaccuracy is running the sleeper.vbs.

2. There is no need for 20 IPCheck functions. They all do the same thing. The only difference is the object on which the function is working. Consider passing in [tt]this[/tt] and reducing the number of function to 1.

Code:

Sub IPCheck(objElement)
		On Error Resume Next
		If objElement.Value > 255 OR IsNumeric(objElement.Value) = False  Then
		    objElement.style.backgroundcolor = "red"
		    Sleep "1"
			objElement.Value = ""
			objElement.style.backgroundcolor = "lightcyan"
		End If
		If Len(objElement.Value) = 3 OR InStr(objElement.Value, ".") > 0 Then
			objElement.Value=Replace(objElement.Value,".","")
			objElement.Focus
			objElement.Select
		End If
End Sub	

<input type='text' class="IP" maxLength="3" onKeyUp="[highlight #FCE94F][i]IPCheck(this)[/i][/highlight]" name="N9" />

-Geates

http://ns7.webmasters.com/caspdoc/html/vbscript_language_reference.htm

crackoo · Apr 9, 2013

Hi Geates
First of all ; I want to thank you for the optimisation of my code it's very intersting and i like it [2thumbsup]

However, i wonder for your last remark how we can do someting like this :

Code:

Sub IPCheck(objElement(i))
	On Error Resume Next
	If objElement.Value > 255 OR IsNumeric(objElement.Value) = False  Then
		    objElement.style.backgroundcolor = "red"
		    Sleep "1"
			objElement.Value = ""
			objElement.style.backgroundcolor = "lightcyan"
	End If
	If Len(objElement.Value) = 3 OR InStr(objElement.Value, ".") > 0 Then
		objElement.Value=Replace(objElement.Value,".","")
		objElement(i+1).Focus
		objElement(i+1).Select
End If
End Sub

I know the syntax is incorrect, but just for understand me what i want to do
for exemple :

Code:

Sub IPCheckN1()
		On Error Resume Next
		If N1.Value > 255 OR IsNumeric(N1.Value) = False  Then
		    N1.style.backgroundcolor = "red"
		    Sleep "1"
			N1.Value = ""
			N1.style.backgroundcolor = "lightcyan"
		End If
		If Len(N1.Value) = 3 OR InStr(N1.Value, ".") > 0 Then
			N1.Value=Replace(N1.Value,".","")
			[COLOR=#EF2929][b]N2.Focus
			N2.Select[/b][/color]
		End If
End Sub
	
Sub IPCheckN2()
		On Error Resume Next
		If N2.Value > 255 OR IsNumeric(N2.Value) = False  Then
		    N2.style.backgroundcolor = "red"
		    Sleep "1"
			N2.Value = ""
			N2.style.backgroundcolor = "lightcyan"
		End If
		If Len(N2.Value) = 3 OR InStr(N2.Value, ".") > 0 Then
			N2.Value=Replace(N2.Value,".","")
			[COLOR=#EF2929][b]N3.Focus
			N3.Select[/b][/color]
		End If
End Sub

Geates · Apr 9, 2013

In order to do that, all we need is the next element. Because the DOM is hierarchical, all elements are related, just like a family tree. As long as we have a starting point, it's relatively easy to get the next element. Our starting point is our current element, and, you lucky for us, there is a DOM node function, .nextSibling(), which makes ir ridiculously easy to get the next element.

Unfortunately, I have had miserable experiences working with the DOM in vbscript. A perfect example of my frustrating DOM experiences is evidenced by the mistake above! The [tt]this[/tt] in "IPCheck(this)" passes a reference of the current HTML object to IPCheck(); it is not interpreted correctly by vbscript

so there isn't much use for it here. Instead, I'm going to take the "it will only work for this program" approach and pass in the name of the HTML element, dissect and rebuild the name to get the "next" element.

Code:

Sub IPCheck(objElement)
	on error resume next
	If int(objElement.Value) > 255 OR IsNumeric(objElement.Value) = False  Then
		objElement.style.backgroundcolor = "red"
		Sleep "1"
		objElement.Value = ""
		objElement.style.backgroundcolor = "lightcyan"
	End If
	If Len(objElement.Value) = 3 OR InStr(objElement.Value, ".") > 0 Then
		objElement.Value=Replace(objElement.Value,".","")[s][/s]
		[highlight #FCE94F]strNext = "N" & cstr(int(mid(strElementName, 2)) + 1)[/highlight]
		[highlight #FCE94F]set objNext= document.getElementsByName(strNext)(0)[/highlight]
		[highlight #FCE94F]objNext.focus()[/highlight]
	End If
End Sub	

<input type='text' class="IP" maxLength="3" onKeyUp="IPCheck(N9)" name="N9" />

NOTE: Because DOM + VBS = Hell, this code contains errors that are suppressed by [tt]on error resume next[/tt] which otherwise shouldn't occur

-Geates

http://ns7.webmasters.com/caspdoc/html/vbscript_language_reference.htm

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

[HTA] Text box control with valid IP addresses 1

crackoo

Programmer

Geates

Programmer

crackoo

Programmer

crackoo

Programmer

Geates

Programmer

crackoo

Programmer

Geates

Programmer

Similar threads

Part and Inventory Search

Sponsor