[vbs] comment créer un dossier et le protéger par mot de passe

Soyez le premier à donner votre avis sur cette source.

Vue 10 544 fois - Téléchargée 1 293 fois

Description

Ce Vbscript est en "version beta" et je veux le partager avec vous pour des tests sur vos machines, et bien sûr, vous devriez me donner vos commentaires et vos suggestions pour améliorer ce dernier.
Alors ce script vous montre comment créer un dossier et le protéger par mot de passe Crypté et stocké dans la base des registres, il crée un dossier nommé "C:\Protection" puis il lui attribue une permission d'accès refusée, donc vous ne pouvez pas ni renommer ni ouvrir, ni écrire, ni lire ni supprimer ce dossier.
Ce script modifie les attributs du dossier pour "+ r + s + h" et révoque les autorisations pour %COMPUTERNAME% et le groupe d'administrateurs après avoir invité à saisir un mot de passe. Et ces changements revient après le même mot de passe qui a été fourni.
NB:Ce Script n'est pas sécurisé à 100% en effet le propriétaire du dossier et tout membre du groupe Administrateurs peuvent modifier ces autorisations sans passer par le mot de passe connaissant bien sûr la bonne syntaxe en ligne de commande.
- Ce Script est testé sous Windows 7 64-bits Version Française

Source / Exemple :


Set Dans le Zip :
Sub Installation()
-Installation du mot de passe pour le dossier Protection : Permissiondossier.vbs
End Sub

Sub Désinstallation()
-Désinstallation et réinitialisation du mot de passe : Desinstall_Protection.vbs
End Sub

Conclusion :


Donc j'attends de vous un bon Test et de me signaler les bugs et les messages d'erreurs que vous trouviez avec votre envrionnement de travail(Système d'exploitation) afin d'améliorer ensemble ce Vbscript ! et si par hasard vous avez testé ce script et qu'il marche bien pour vous, alors SVP laissez un commentaire du genre:
-C'est OK ça marche bien testé (sous quel version de windows)!

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_hackoo
Messages postés
94
Date d'inscription
mercredi 3 avril 2002
Statut
Membre
Dernière intervention
29 juillet 2013
-
@ZIPPEDFIRE : Teste encore ce Vbscript Pour la désinstallation et le déblocage du dossier Protection peut-être va marcher pour toi maintenant

Const Key = "HKLM\Software\Protection"
Const MDP = "HKLM\Software\Protection\MDP"
InputPassword

Sub Debloquer()
Set WshNetwork = CreateObject("WScript.Network")
NomMachine = WshNetwork.ComputerName
NomUtilisateur = WshNetwork.UserName
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists("c:\Protection") Then
Command1 = "%COMSPEC% /c Echo o| cacls c:\Protection /g " & qq(NomMachine) & ":f administrateurs:f"
Command2 = "%COMSPEC% /c attrib -s -h -r c:\Protection"
Result1 = objShell.Run(Command1,0,True)'exécution de la commande sans afficher la console MS-DOS
Result2 = objShell.Run(Command2,0,True)'exécution de la commande sans afficher la console MS-DOS
If Result <> 0 Then
MsgBox "Permissions sur le dossier non fait",16,"Permissions sur le dossier non fait"
End If
End if
End Sub
'==============
Function qq(strIn)
qq = Chr(34) & strIn & Chr(34)
End Function
'==============
Function Scramble (strText, lngSeed)
Dim L,intRand,bytASC
'---- Force seeded random mode
Rnd(-1)
'---- Set (positive) seed
Randomize ABS(lngSeed)
'---- Scan through string
For L = 1 To Len(strText)
'---- Get ASC of char
bytASC=Asc(Mid(strText, L))
'---- Fix for quotes (tilde to quote)
If bytASC=126 then bytASC=34
'---- Add a random value from -80 to 80, encode\decode is decided by the seed's sign
intRand = bytASC + ((Int(Rnd(1) * 160) - 80) * SGN(lngSeed))
'---- Cycle char between 32 and 125 (with carry)
If intRand <= 31 Then
intRand = 125 - (31 - intRand)
ElseIf intRand >= 126 Then
intRand = 32 + (intRand - 126)
End If
'---- Fix for quotes (quote to tilde)
If intRand=34 then intRand=126
'---- Output string
Scramble = Scramble & Chr(intRand)
Next
End Function
'========================
Sub InputPassword()
Const ForWriting = 2
Const ForAppending = 8
Dim Ws,Password,itemtype,LireMDP
If Not RegExists(MDP) Then MsgBox "Mot de passe non installé !",16,"Mot de passe non installé !" :Wscript.Quit(0): End If
Titre=" Protection Dossier © Hackoo © 2011 "
Set Ws = CreateObject("Wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
itemtype = "REG_SZ"
Set colItems = GetObject("winmgmts:root\cimv2").ExecQuery("Select ScreenHeight, ScreenWidth from Win32_DesktopMonitor Where ScreenHeight Is Not Null And ScreenWidth Is Not Null")

For Each objItem in colItems
intHorizontal = objItem.ScreenWidth
intVertical = objItem.ScreenHeight
Next
On error resume next
Dim objExplorer : Set objExplorer = WScript.CreateObject("InternetExplorer.Application", "IE_")
With objExplorer
.Navigate "about:blank"
.ToolBar = 0
.Left = (intHorizontal-300) / 2
.Top = (intVertical-100) / 2
.StatusBar = 0
.Width = 320
.Height = 190
.Visible = 1
.Resizable = 0
.MenuBar = 0
.Document.Title = "Mot de Passe © Hackoo ****** "
Dim strHTML : strHTML = "<center>Entrez Votre Mot de Passe
"
strHTML = strHTML &""
strHTML = strHTML & "
"
strHTML = strHTML & "
Envoyer </center>"
.Document.Body.InnerHTML = strHTML
.Document.body.style.backgroundcolor="lightblue"
End With
Do While (objExplorer.Document.All.btn_Exit.Value = "Envoyer")
Wscript.Sleep 250
Loop
Password = Trim(objExplorer.document.GetElementByID("txt_Password").Value)
'PassowrdCrypt = Scramble(Password,2011) ' ICI : ça semble marcher mais pas à l'exécution j'ai dû l'enlever
objExplorer.Quit
Set objExplorer = Nothing

If Scramble(Password,2011) = WS.RegRead(MDP) Then 'LireMDP then
Question = MsgBox ("Voulez-vous accéder à votre Dossier protégé ?",VBYesNO+VbQuestion,Titre)
If Question = VbYes then
Call Debloquer()
Explorer "c:\Protection"
WS.RegDelete Key
End If
Else
Set Voix = CreateObject("SAPI.Spvoice")
Voix.Speak "PASSWORD INCORRECT AND PERMISSION DENIED TO ACCESS TO THIS FOLDER."
Msgbox "MOT DE PASSE INCORRECT ET PERMISSION REFUSEE D'ACCEDER A CE DOSSIER" & VbCrlf & _
"PASSWORD INCORRECT AND PERMISSION DENIED TO ACCESS TO THIS FOLDER",16,"MOT DE PASSE INCORRECT Hackoo © 2011 !"
End If
End Sub
'--------------------Fin du InputPassword-------------
Function Explorer(File)
Set ws=CreateObject("wscript.shell")
ws.run "Explorer " & File '& ""
end Function
'==================
Function RegExists(value)
On Error Resume Next ' Sans cette instruction, une erreur se produit si MDP n'existe pas(val="")
Set WS = CreateObject("WScript.Shell")
val = WS.RegRead(value)
RegExists = (Err.number <> -2147024893) And (Err.number <> -2147024894) And val<> ""
End Function
zippedfire
Messages postés
97
Date d'inscription
mercredi 6 octobre 2010
Statut
Membre
Dernière intervention
5 juin 2015
2 -
ca marche toujours pas j peux pas ouvrir le dossier protection
cs_hackoo
Messages postés
94
Date d'inscription
mercredi 3 avril 2002
Statut
Membre
Dernière intervention
29 juillet 2013
-
Voici un Vbscript pour Pour la désinstallation et le déblocage du dossier Protection:

'*********************************UninstallProtection.vbs**************************************
Call UNINSTALL
Call Debloquer
Sub UNINSTALL
Dim Ws
Set Ws = CreateObject("Wscript.Shell")
itemtype = "REG_SZ"
Title = "DEINSTALLATION DE VOTRE MOT DE PASSE POUR LE DOSSIER PROTECTION © Hackoo © 2011"
If MsgBox ("VOULEZ-VOUS DEINSTALLER VOTRE MOT DE PASSE POUR LE DOSSIER PROTECTION !",VbQuestion+VbYesNo ,Title ) = VbNo Then
Msgbox "Vous avez choisi d'annuler la déinstallation de votre MOT DE PASSE ! !",64,Title
WScript.Quit(0)
Else
If RegExists("HKLM\Software\Protection\MDP") Then ' On lit ici la donnée de la valeur MDP qui retourne Vrai si elle existe
Ws.RegDelete("HKLM\Software\Protection")
Msgbox "VOTRE MOT DE PASSE A ETE DEINSTALLER DU SYSTEME AVEC SUCSSES !",64,Title
End If
End If
End Sub

Function RegExists(value)
On Error Resume Next
Set WS = CreateObject("WScript.Shell")
val = WS.RegRead(value)
RegExists = (Err.number <> -2147024893) And (Err.number <> -2147024894)
End Function
'=====================
Sub Debloquer()
Set WshNetwork = CreateObject("WScript.Network")
NomMachine = WshNetwork.ComputerName
NomUtilisateur = WshNetwork.UserName
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists("c:\Protection") Then
Command1 = "%COMSPEC% /c Echo o| cacls c:\Protection /g " & qq(NomMachine) & ":f administrateurs:f"
Command2 = "%COMSPEC% /c attrib -s -h -r c:\Protection"
Result1 = objShell.Run(Command1,0,True)'exécution de la commande sans afficher la console MS-DOS
Result2 = objShell.Run(Command2,0,True)'exécution de la commande sans afficher la console MS-DOS
If Result <> 0 Then
MsgBox "Permissions sur le dossier non fait",16,"Permissions sur le dossier non fait"
End If
End if
End Sub
'=============
Function qq(strIn)
qq = Chr(34) & strIn & Chr(34)
End Function
cs_hackoo
Messages postés
94
Date d'inscription
mercredi 3 avril 2002
Statut
Membre
Dernière intervention
29 juillet 2013
-
@Chrysostome il faut cliquer sur le Vbscript une autre fois pour saisir le mot de passe et débloquer le dossier Protection ! et non pas sur le dossier lui-même !
cs_Chrysostome
Messages postés
40
Date d'inscription
vendredi 17 octobre 2003
Statut
Membre
Dernière intervention
8 juillet 2013
-
Bon! Entre 2 séjours de vacances, je re-clique dessus le dossier "Protection" que j'ai créé:

Message:

"I:\Protection n'est pas accessible.
Accès refusé.

Ai-je été plus explicite? La réponse étant métaphysiquement plus délicate que la question, c'est pour cela que je ne m'étendrai pas plus, de peur d'être hors-sujet. Bon débug à toi.

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.