[VBS] COMMENT CRÉER UN DOSSIER ET LE PROTÉGER PAR MOT DE PASSE
zippedfire
Messages postés
98
Date d'inscription
mercredi 6 octobre 2010
Statut
Membre
Dernière intervention
21 novembre 2023
-
10 août 2011 à 14:22
cs_hackoo Messages postés 91 Date d'inscription mercredi 3 avril 2002 Statut Membre Dernière intervention 29 juillet 2013 - 24 août 2011 à 22:07
cs_hackoo Messages postés 91 Date d'inscription mercredi 3 avril 2002 Statut Membre Dernière intervention 29 juillet 2013 - 24 août 2011 à 22:07
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
https://codes-sources.commentcamarche.net/source/53448-vbs-comment-creer-un-dossier-et-le-proteger-par-mot-de-passe
24 août 2011 à 22:07
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
22 août 2011 à 17:34
22 août 2011 à 14:58
'*********************************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
22 août 2011 à 13:58
22 août 2011 à 11:56
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.
19 août 2011 à 15:48
JE FAIS UN TRUC PAS EN ADMINISTRATEUR ET APRÈS JE SUIS DANS LA M****!
(5ème fois bloqué sur cs)
16 août 2011 à 08:09
sous windows xp pro le fichier est caché alors que normalement les fichiers cachés sont visibles à ma demande et impossible à ouvrir aucune demande de mot de passe
acces refusé
je suis en administrateur
15 août 2011 à 22:22
Quand on clique dessus tu veux dire sur le dossier Protection ?
15 août 2011 à 18:52
11 août 2011 à 20:02
11 août 2011 à 20:00
11 août 2011 à 19:02
rd c:\Protection /q
11 août 2011 à 18:12
11 août 2011 à 11:22
10 août 2011 à 23:01
10 août 2011 à 20:28
et quand j'ai lancé le vbs la 2ème fois ca ma demandé le mot de passe j'ai tapé le bon et ca m'a ouvert le dossier C:\Protection(enfin pas vraiment) et ca ma affiché "Impossible d'accéder au dossier "C:\Protection". Accès refusé. Je ne suis pas administrateur et je ne sais pas comment faire.
10 août 2011 à 17:12
10 août 2011 à 17:01
-Pour mon côté je l'ai tester sous Windows 7 Version 64 Bits Française et il marche super bien !
-essaie maintenant de télécharger la mise jour , donc tu réinitialise le mot de passe et installe-le de nouveau et dis-moi le résultat!
@Bientôt
10 août 2011 à 16:47
Très bon programme, mais n'est pas opérationnel sous XP. Je m'explique:
Le dossier est bien créé mais on peut le supprimer, l'ouvrir etc. La clé dans le registre est créée aussi. Je ne sais pas ce qui manque. J'ai mis un mauvais mot de passe, il y a un message d'alerte. Mais cela n'empêche pas d'accéder au dossier Protection et de faire ce que l'on veut.
Bonne continuation, tes programme sont toujours instructifs!
@+ Le Pivert.
10 août 2011 à 14:45
10 août 2011 à 14:22