HTA password pour accès

Version imprimable

Question de s'amuser...

J'ai créé un petit hta (script 1) qui permet l'accès a un autre hta (second script) si un mot de passe déterminé est inscrit...je me demandais y aurait-il un option de faire le même principe à l'intérieur du second script sans passer par le premier...En fait y a t-il moyen de "barrer" l'utilisation d'un hta a l'aide d'un mot de passe à même le script
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub TestSub If PasswordArea.Value = "motdepasse" Then Set objShell = CreateObject("WScript.Shell") objShell.Run("C:\Users\padawan\Choice.hta") window.close Else MsgBox "Wrong Password Dude..." Location.Reload(True) End If End Sub </SCRIPT>  <input type="password" name="PasswordArea" size="30"><P> <input id=runbutton class="button" type="button" value="Accès" name="run_button" onClick="TestSub">
À la limite aussi avec une tentative de 3 essais autrement "quit"...

Merci

:salut: à tester chez vous :mouarf: :zoubi:

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
<html> 
<head> 
<HTA:APPLICATION 
    ICON="Explorer.exe"
    APPLICATIONNAME = "Login" 
    BORDER="dialog"
    BORDERSTYLE="complex"
    CONTEXTMENU="no"
    SYSMENU="yes"
    MAXIMIZEBUTTON="no"
    SCROLL="no" 
>
<title>VerifPass+NBEssais © Hackoo</title> 
<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 280,180
       Call TextFocus
       Call Fermer("Explorer.exe")
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 VerifPass
Dim NB_MAX : NB_MAX = 3
Password = "motdepasse"
Set Readfile = objFSO.OpenTextFile(Essais,1)
Compteur = Readfile.ReadAll
Readfile.Close
Controle = True
While Controle
        Compteur = Compteur + 1
        NB_Essais_Restant = NB_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
                Call Ouvrir("Explorer.exe")
                resultat=WS.Run("Calc.exe",1,False)'si le mot est correct on lance l'application calculatice
                Controle = False
                window.close
            Exit Sub
        End If
          If Compteur = NB_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)
               Exec = WS.Run(Command,0,False) 
               window.close
             End If
        Exit Sub
wend     
End Sub
 
Sub TextFocus
  PasswordArea.Focus 
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
 
</SCRIPT>
</head> 
<body STYLE="font:14 pt arial; color:white;filter:progid:DXImageTransform.Microsoft.Gradient
(GradientType=1, StartColorStr='#000033', EndColorStr='#0000FF')"
<!--HTMLPORTION-->
<center>Mot de Passe<br><br><input type="password" name="PasswordArea" size="20" onKeyUp="TextFocus"><P>
<input id=runbutton  class="button" type="Submit" value="Accès" name="run_button"  onClick="VerifPass">
</body>
</html>

04/08/2012, 12h31
hackoofr

1 pièce(s) jointe(s)

:salut:
Pour les tentatives on est d'accord, et on peut même les configurer. Juste vous modifiez le NB_Essais_MAX dans le HTA :zoubi:
Pour utiliser un mot de passe afin d'accéder à un 2 ème HTA j'ai pensé de générer ce dernier dans le même HTA de cette façon dans la pièce-jointe :
05/08/2012, 16h16
Invité

Vraiment intéressant...

J'ai utilisé le premier exemple/en changeant quelques éléments avec les tentatives d'essai et c'est parfait...

Toutefois pour ce qui est du deuxième (celui généré a même) J'obtient une erreur ligne 178 -2 Fichier introuvable....ce qui est

CreateObject("WScript.Shell").Run "Sleeper.vbs" & MSecs,1 , True

Merci pour ces exemples j'adore apprendre de la sorte

:ccool:

:salut:
On ne peut pas utiliser le ~~WScript.Sleep~~ dans une Application HTA.
Donc pour contourner ce genre de problème on va utiliser cette fonction Sleep(MSecs)
Code:

1 2 3 4 5 6 7 8 9 10 11 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
Donc dans la ligne N°178 j'ai oublié de changer le chemin de sleeper.vbs de cette façon :
au lieu de

Code:

CreateObject("WScript.Shell").Run "Sleeper.vbs" & MSecs,1 , True

il faut le changer comme ceci :

Code:

CreateObject("WScript.Shell").Run tempFolder&"\"&tempName &" "& MSecs,1,True

Normalement ça va marcher maintenant pour vous donc juste vous re-téléchagez le fichier dans la pièce-jointe que je l'ai modifié :lol: :ccool:

08/08/2012, 03h42
Invité

Merci hackoofr

Je vais travailler la dessus et adapter en fonction de ce que je veux...à la base ton exemple me donne une très bonne idée...

Merci encore
08/08/2012, 11h56
hackoofr

:salut:
je suis ravis que les scripts vous donnent des idées, alors surtout n'oubliez pas de nous partager votre script final :ccool: :mouarf: :zoubi: :merci:
Bonne Continuation :pc:

:salut:
J'ai trouvé une autre solution sans passer par un HTA ou un fichier temporaire.
Ce script utilise la méthode innerHTML. http://hfr.toyonos.info/generateurs/fb/?t=Hackoo
Donc à tester chez vous et dis-moi si cette solution vous conviendriez mieux ou non :ccool:

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
<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>