[VBS] COMMENT CRÉER UN DOSSIER ET LE PROTÉGER PAR MOT DE PASSE

Signaler
Messages postés
97
Date d'inscription
mercredi 6 octobre 2010
Statut
Membre
Dernière intervention
5 juin 2015
-
Messages postés
92
Date d'inscription
mercredi 3 avril 2002
Statut
Membre
Dernière intervention
29 juillet 2013
-
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/53448-vbs-comment-creer-un-dossier-et-le-proteger-par-mot-de-passe

Messages postés
92
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
Messages postés
97
Date d'inscription
mercredi 6 octobre 2010
Statut
Membre
Dernière intervention
5 juin 2015
8
ca marche toujours pas j peux pas ouvrir le dossier protection
Messages postés
92
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
Messages postés
92
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 !
Afficher les 21 commentaires