Je suis entrain de faire ce HTA : File Protection.hta, il fonctionne sur Windows XP formaté en NTFS.
Mais il ne fonctionne pas sur Vista et seven si le UAC est activé.
Je cherche alors, comment ajouter une fonction qui me vérifie la version du système d'exploitation et si elle correspond à Vista ou à Seven, alors elle continue de vérifier si UAC est activé ou non:
Si le UAC est activé alors elle demande à l'utilisateur par un MsgBox de choisir de désactiver ou non le UAC pour continuer à utiliser ce HTA:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
<html> 
<head> 
<HTA:APPLICATION 
ICON="Explorer.exe"
APPLICATIONNAME = "File Protection © Hackoo © 2012" 
BORDER="dialog"
BORDERSTYLE="complex"
CONTEXTMENU="no"
SYSMENU="yes"
MAXIMIZEBUTTON="no"
SCROLL="no" 
SINGLEINSTANCE="yes"
>
<title>File Protection © Hackoo © 2012</title> 
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")
Titre = "File Protection © Hackoo © 2012"
Temp = WS.ExpandEnvironmentStrings("%Temp%")
Essais = Temp &"\Essais.txt"
Sub window_onload()
    CenterWindow 250,150
    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()
    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"" name=""run_button""  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()
            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 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 MenuPrincipal() 
        CALL InnerWindowSize(350,150) 
        Self.document.title = "File Protection © Hackoo © 2012"
 
        ONSCR.InnerHTML="<input type=""file"" name=""file"" id=""file"" /><br><br>"&_
        "<CENTER><INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""Protect File"" ONCLICK=""Deny(file.value)""><P>"&_
        "<CENTER><INPUT TYPE=""BUTTON"" STYLE=""HEIGHT:25;WIDTH:165"" VALUE=""UnProtect File"" ONCLICK=""Allow(file.value)""><P>" 
    END SUB 
 
    Function Deny(objet)
        Titre = "File Protection © Hackoo © 2012"
        Set Ws = CreateObject("WScript.Shell")
        Set ProcessEnv = Ws.Environment("Process")
        NomUtilisateur = ProcessEnv("USERNAME")
        If objet = "" Then 
            MsgBox "Le Fichier n'existe pas, il faut choisir un Fichier",VbExclamation,Titre
            Exit Function
        End if
        Command1 = "%COMSPEC% /c Echo o| cacls "& qq(objet) &" /P " & qq(NomUtilisateur) & ":N administrateurs:N"
        Command2 = "cmd /c cacls "&qq(objet)&" > %temp%\Deny.txt"
        Command3 = "cmd /c Type %temp%\Deny.txt | find /c "":N"" > %temp%\ResDeny.txt" 
        Result1 = ws.Run(Command1,0,True) 'exécution de la commande sans afficher la console MS-DOS
        Result2 = ws.Run(Command2,0,True)
        Result3 = ws.Run(Command3,0,True)
        Temp = objFSO.GetSpecialFolder(2)
        Set Readfile = objFSO.OpenTextFile(Temp&"\ResDeny.txt",1)
        Valeur = Readfile.ReadAll
        Readfile.Close
        If Valeur = 2 Then
            MsgBox "Le Fichier  "& qq(objet) &" est verouillé avec succés !",64,"Le  "& qq(objet) &" est Verouillé avec succés !"
        Else
            MsgBox qq(objet) &" Echec de l'opération !",16,qq(objet) &" Echec de l'opération !"
        End if
    End Function
 
    Function Allow(objet)
        Titre = "File Protection © Hackoo © 2012"
        Set Ws = CreateObject("WScript.Shell")
        Set ProcessEnv = Ws.Environment("Process")
        NomUtilisateur = ProcessEnv("USERNAME")
        If objet = "" Then 
            MsgBox "Le Fichier n'existe pas, il faut choisir un Fichier",VbExclamation,Titre
            Exit Function
        End if
        Command1 = "%COMSPEC% /c Echo o| cacls "& qq(objet) &" /g " & qq(NomUtilisateur) & ":f administrateurs:f > %temp%\Allow.txt"
        Command2 = "cmd /c cacls "&qq(objet)&" > %temp%\Allow.txt"
        Command3 = "cmd /c Type %temp%\Allow.txt | find /c "":F"" > %temp%\ResAllow.txt" 
        Result1 = ws.Run(Command1,0,True) 'exécution de la commande sans afficher la console MS-DOS
        Result2 = ws.Run(Command2,0,True)
        Result3 = ws.Run(Command3,0,True)
        Temp = objFSO.GetSpecialFolder(2)
        Set Readfile = objFSO.OpenTextFile(Temp&"\ResAllow.txt",1)
        Valeur = Readfile.ReadAll
        Readfile.Close
        If Valeur = 2 Then
            MsgBox "Le Fichier  "& qq(objet) &" est verouillé avec succés !",64,"Le  "& qq(objet) &" est Verouillé avec succés !"
        Else
            MsgBox qq(objet) &" Echec de l'opération !",16,qq(objet) &" Echec de l'opération !"
        End if
    End Function
 
    Function qq(strIn)
        qq = Chr(34) & strIn & Chr(34)
    End Function
 
    Sub PasswordForm()
        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"" name=""run_button""  onClick=""VerifPass"">"_
    END Sub
    Call PasswordForm()
    </script>