Version du Système d'exploitation

Version imprimable

:salut:
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é. :aie:
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:

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>

:merci:

Salut,

Un petit script pour les informations système en vbs .

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
'Informations sur votre système d'exploitation
 
On Error Resume Next
Set oShell = CreateObject("wscript.Shell")
Set env = oShell.environment("Process")
 
strComputer = env.Item("Computername")
 
Dim objWMIService
Dim colItems, objItem
 
Set objWMIService = GetObject("winmgmts:\\"&  strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
 
For Each objItem in colItems
    WScript.Echo "Informations OS" & VbCr & _
    "Editeur: " & objItem.Manufacturer & VbCr & _
    "Système d'Exploitation: " & objItem.Caption & VbCr & _
    "Version: " & objItem.Version & VbCr & _
    "Service Pack: " & objItem.CSDVersion & VbCr & _
    "GUID: " & objItem.SerialNumber & VbCr & _
    ""
Next
 
WSCript.Quit

26/12/2012, 16h12
omen999

salut,
pour récupérer la version de l'os, lire la propriété Version de la classe Win32_OperatingSystem
un exemple de lecture de toutes les propriétés de cette classe ici
bonne lecture ;)

edit : grilled :P
26/12/2012, 16h15
Invité

Merci pour le lien omen999 :ccool:

:salut: et :merci: pour vos réponses :ccool:
et par la même occasion, j'ai trouvé deux scripts qui me renvoie la version du système d'exploitation.
1er Script :

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
Msgbox GetOS,64,"Version du Système d'exploitation"
 
Function GetOS()
'WMI is required for this script to function
    Dim strComputer, strWMIOS
'If you only want to use locally, remove the inputbox and make strComputer = "."
    strComputer = Inputbox("Input the name of the remote computer or hit enter for this PC.")
    If strComputer = "" then
        strComputer = "."
    End if
 
    Dim objWmiService : Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\"& strComputer & "\root\cimv2")
    Dim strOsQuery : strOsQuery = "Select * from Win32_OperatingSystem"
    Dim colOperatingSystems : Set colOperatingSystems = objWMIService.ExecQuery(strOsQuery)
    Dim objOs
    Dim strOsVer
 
    For Each objOs in colOperatingSystems
        strWmios = objOs.Caption & " " & objOs.Version
    Next
 
    Select Case True
'Add more info to the 98 and 95 to get the specific version. i.e. 98SE 95 a,b,or c
    Case InStr(strWmiOS, "2000 Server") > 1 : GetOS = "2KSRV"
    Case InStr(strWmiOS, "2003, Standard") > 1 : GetOS = "2K3SRV"
    Case InStr(strWmiOS, "2003, Enterprise") > 1 : GetOS = "2K3ENTSRV"
    Case InStr(strWmiOS, "2000 Advanced Server") > 1 : GetOS = "2KADVSRV"
    Case InStr(strWmiOS, "Windows NT") > 1 : GetOS = "NT4"
    Case InStr(strWmiOS, "Windows 2000") > 1 : GetOS = "W2K"
    Case InStr(strWmiOS, "Windows XP") > 1 : GetOS = "WIN XP"
    Case InStr(strWmiOS, "Windows Vista") > 1 : GetOS = "WIN Vista"
    Case InStr(strWmiOS, "Windows 7") > 1 : GetOS = "WIN 7"
    Case Else : GetOS = "Unknown"
    End Select
End Function

2ème Script :

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
MsgBox FindOSType("."),64,"Système d'exploitation"
Function FindOSType(strComputer)
'Defining Variables
    Dim objWMI, objItem, colItems
    Dim OSVersion, OSName, ProductType
 
'Get the WMI object and query results
    Set objWMI = GetObject("winmgmts://" & strComputer & "/root/cimv2")
    Set colItems = objWMI.ExecQuery("Select * from Win32_OperatingSystem",,48)
 
'Get the OS version number (first two) and OS product type (server or desktop) 
    For Each objItem in colItems
        OSVersion = Left(objItem.Version,3)
        ProductType = objItem.ProductType
    Next
'Time to convert numbers into names
    Select Case OSVersion
    Case "6.1"
        OSName = "Windows 7"
    Case "6.0" 
        OSName = "Windows Vista"
    Case "5.2" 
        OSName = "Windows 2003"
    Case "5.1" 
        OSName = "Windows XP"
    Case "5.0" 
        OSName = "Windows 2000"
    Case "4.0" 
        OSName = "Windows NT 4.0"
    Case Else
        OSName = "Windows 9x"
    End Select
 
'Return the OS name
    FindOSType = OSName
 
'Clear the memory
    Set colItems = Nothing
    Set objWMI = Nothing
End Function

:merci: