Exemple de menu en hta avec password et limite de nombre d'essais

Soyez le premier à donner votre avis sur cette source.

Vue 6 960 fois - Téléchargée 871 fois

Description

Cet Exemple montre bien comment gérer plusieurs Formulaires dans un seul HTA, en utilisant la méthode InnerHTML et ceci dont le but de répondre à une question dans un forum VBScript.

Source / Exemple :


<HTML><HEAD> 
 <TITLE></TITLE> 
 <HTA:APPLICATION 
 APPLICATIONNAME="Exemple de Menu en HTA" 
 BORDER="THIN" 
 BORDERSTYLE="NORMAL" 
 ICON="Explorer.exe" 
 INNERBORDER="NO" 
 MAXIMIZEBUTTON="NO" 
 MINIMIZEBUTTON="NO" 
 SCROLL="NO" 
 SELECTION="NO" 
 SINGLEINSTANCE="YES"/></HEAD> 
 <META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES"> 
 <BODY TOPMARGIN="1" LEFTMARGIN="1"><CENTER><DIV><SPAN ID="ONSCR"></SPAN></DIV></CENTER></BODY>
  
 <SCRIPT LANGUAGE="VBScript"> 
 Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim WS : Set WS = CreateObject("wscript.shell")
Temp = WS.ExpandEnvironmentStrings("%Temp%")
Essais = Temp &"\Essais.txt"
Sub window_onload()
       CenterWindow 230,130
       Call TextFocus
Dim Compteur : Compteur = 0
If Not objFSO.FileExists(Essais) Then 
Dim Logfile : Set Logfile = objFSO.OpenTextFile(Essais,2,True)
Logfile.writeline Compteur
Logfile.Close
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

Sub PasswordForm()
Fermer("Explorer.exe")
Self.document.title = "Mot de passe"
Self.document.bgColor = "#BBBFFF"
ONSCR.InnerHTML="<center><FONT COLOR=""#FFFFFF"" SIZE=""+1"" FACE=""VERDANA,ARIAL,HELVETICA,SANS-SERIF"">Mot de Passe</FONT<br><input type=""password"" name=""PasswordArea"" size=""20"" onKeyUp=""TextFocus""><P>"_
&"<input type=""Submit"" STYLE=""HEIGHT:25;WIDTH:110"" value=""Accès Au Menu"" onClick=""VerifPass"">"
END Sub

Sub VerifPass
Dim NB_Essais_MAX : NB_Essais_MAX = 3
Password = "123"
Set Readfile = objFSO.OpenTextFile(Essais,1)
Compteur = Readfile.ReadAll
Readfile.Close
Controle = True
While Controle
        Compteur = Compteur + 1
        NB_Essais_Restant = NB_Essais_MAX - Compteur
        Set Logfile = objFSO.OpenTextFile(Essais,2,True)
        Logfile.writeline Compteur
        Logfile.Close
		If PasswordArea.Value <> Password Then
		     MsgBox "Mauvais Mot de passe et NB° ESSAIS est " & Compteur &vbCr&_
		     "Le Nombre d'essais restant est "& NB_Essais_Restant,16,"Mauvais Mot de passe"
		     Location.Reload(True)
		end if
		If PasswordArea.Value = Password Then
		
		    MsgBox "Mot de Passe Correct !",64,"Mot de Passe Correct !"
		      If objFSO.FileExists(Essais) Then objFSO.DeleteFile Essais,True
		         Controle = False
		         Call MenuPrincipal()
		         Call Ouvrir("Explorer.exe")
			Exit Sub
	    End If
	      If Compteur = NB_Essais_MAX Then
		     If objFSO.FileExists(Essais) Then objFSO.DeleteFile Essais,True
    	       MsgBox "Le Nombre Limite d'essais est atteint ! "&vbcr& "L'ordinateur va Rebooter dans 30 secondes ",48,"Le Nombre Limite de Essai est atteint"
    	       Command="cmd /c Shutdown.exe -r -t 30 -c " & chr(34) & "Sauvegarder votre Travail car l'ordinateur va rebooter dans 30 secondes" & chr(34)
    	       'Executer = WS.Run(Command,0,False) 
    	       window.close
             End If
    	Exit Sub
wend	 
End Sub

Sub TextFocus
  PasswordArea.Focus 
End Sub

SUB MenuPrincipal() 
Self.document.title = "Exemple de Menu en HTA"
 CALL InnerWindowSize(222,587) 
 ONSCR.InnerHTML="<TABLE HEIGHT=""50"" WIDTH=""220"" BORDER=""1"" BGCOLOR=""#BBBFFF"" BORDERCOLOR=""#000000"" CELLPADDING=""0"" CELLSPACING=""1"">"_ 
 &"<TR BGCOLOR=""#346E99""><TD COLSPAN=""2""><CENTER><FONT COLOR=""#FFFFFF"" SIZE=""+2"" FACE=""VERDANA,ARIAL,HELVETICA,SANS-SERIF"">Menu Principal</FONT></CENTER></TD></TR></TABLE>"_ 
 &"<TABLE WIDTH=""220"" HEIGHT=""184"" BORDER=""1"" BGCOLOR=""#BBBFFF"" BORDERCOLOR=""#000000"" CELLPADDING=""0"" CELLSPACING=""1"">"_ 
 &"<P><TR><TD><CENTER><INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Lançer la Calcuatrice"" ONCLICK=""Run(1)""><P>"_ 
 &"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Internet Explorer"" LANGUAGE=""VBScript"" ONCLICK=Run(2)><P>"_ 
 &"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Ligne de Commande"" LANGUAGE=""VBScript"" ONCLICK=Run(3)><P>"_ 
 &"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Poste de Travail"" ONCLICK=""Run(4)""><P>"_ 
 &"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Corbeille"" ONCLICK=""Run(5)""><P>"_
 &"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Mes Documents"" ONCLICK=""Run(6)""><P>"_
 &"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Programs Files"" ONCLICK=""Run(7)""><P>"_
 &"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Ajouter/Supprimer APPLI"" ONCLICK=""Run(8)""><P>"_
 &"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Panneau de configuration"" ONCLICK=""Run(9)""><P>"_
 &"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Propriétés d'Affichage"" ONCLICK=""Run(10)""><P>"_
 &"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Bloc Notes"" ONCLICK=""Run(11)""><P>"_
 &"<INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""WinWord"" ONCLICK=""Run(12)""><P>"_
 &"</TD></CENTER></TR></TABLE>" 
 END SUB 
 
 SUB InnerWindowSize(intWidth,intHeight) 
 Self.ResizeTo intWidth,intHeight 
 Self.ResizeTo intWidth+(intWidth-Document.Body.OffsetWidth),intHeight+(intHeight-Document.Body.OffsetHeight) 
 Self.MoveTo (Screen.Width/2)-(intWidth/2),(Screen.Height/2)-(intHeight/2) 
 END SUB 
 
Sub Run(var)
Set WS = CreateObject("WScript.shell")
        Select Case var
        Case 1 WS.run("calc.exe")
        Case 2 WS.run("iexplore.exe")
        Case 3 WS.run("cmd.exe")
        Case 4 WS.run("Explorer.exe ::{20d04fe0-3aea-1069-a2d8-08002b30309d}")'Poste de Travail
        Case 5 WS.run "Explorer.exe ::{645FF040-5081-101B-9F08-00AA002F954E}"'Corbeille    
        Case 6
             MyDoc = WS.SpecialFolders("MyDocuments") & "\"  
             WS.run "Explorer.exe /n,/e,/root,"& MyDoc
        Case 7
             WS.run "Explorer.exe /n,/e,/root,C:\Program Files"
        Case 8
             WS.run "CONTROL.EXE APPWIZ.CPL"  
        Case 9
             WS.run "CONTROL.EXE"
        Case 10
             WS.run "CONTROL.EXE DESK.CPL"
        Case 11
             WS.run "NOTEPAD.EXE"
        Case 12
             WS.run "Winword"          
End select
End Sub 

Sub Fermer(Process)
Set Ws = CreateObject("Wscript.Shell")
Command = "cmd /c Taskkill /F /IM "&Process&""
Execution = Ws.Run(Command,0,True)
End Sub

Sub Ouvrir(Process)
Set Ws = CreateObject("Wscript.Shell")
Command = "cmd /c Start "&Process&""
Execution = Ws.Run(Command,0,True)
End Sub
Call PasswordForm()
</SCRIPT>

Conclusion :


Vos remarques et vos commentaires et surtout votre Votes sont les Bienvenues !

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
lundi 21 juillet 2014
Statut
Membre
Dernière intervention
21 juillet 2014

je suis ravis
Messages postés
92
Date d'inscription
mercredi 3 avril 2002
Statut
Membre
Dernière intervention
29 juillet 2013

@promarc
J'ai vérifié que le programme est téléchargeable et que vous pouvez aussi copier et coller le code ci-dessus dans le notepad et enregistrer-sous par exemple Menu.hta et si vous avez déjà télécharger le HTA dans le ZIP et vous voulez voir le code source, alors vous pouvez faire un clique droit au-dessus et l'ouvrir avec notepad ou bien si vous voulez le voir avec une syntaxe coloré alors vous pouvez télécharger le programme HTAedit dans ce lien http://htaedit.com/
Alors je vous souhaite une Bonne Chance ! et n'oubliez pas d'évaluer ce dernier par votre vote !
Merci !
Messages postés
33
Date d'inscription
lundi 19 février 2007
Statut
Membre
Dernière intervention
22 juin 2013

Le programme est bien mais on me peux pas copier la source ni telecharger.. c est dommage pour comprendre ton appli. Merci
Messages postés
32
Date d'inscription
mercredi 19 mai 2004
Statut
Membre
Dernière intervention
14 avril 2009

Salut hackoo, pas mal ton programme, bien fait, j'essaie de comprendre un peu le VBScript car je travail plus sur VB6.
Cordialement
Messages postés
92
Date d'inscription
mercredi 3 avril 2002
Statut
Membre
Dernière intervention
29 juillet 2013

@promarc
Tu veux dire quoi par ou est la source ?
Afficher les 6 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.