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.
Vos remarques et vos commentaires et surtout votre Votes sont les Bienvenues !
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
- Hta menu
- Essai vbs - Meilleures réponses
- Hta borderstyle - Meilleures réponses
- Menu déroulant javascript - Guide
- Menu fixe flottant scroll - Guide
- Javascript menu dynamique - Guide
- Menu déroulant au clic javascript - Guide
- Comment faire un menu sur word - Conseils pratiques - Visual Basic / VB.NET
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 !
Cordialement
Tu veux dire quoi par ou est la source ?
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.