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

Télécharger le projet
Commenter

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 !
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_hackoo)