Hi
This Vbscript show you how to create a folder and protect it by password !
So he creates a folder named "Protection" then he gives permission access denied, so you can not rename or open, or write, or read or delete this folder !
'--------------------------------------------Description en Français-------------------------------------------'Comment créer un dossier et le protéger par mot de passe par vbscript © Hackoo Août 2011'ce vbscript crée un dossier nommé "Protection" puis il lui accorde une permission'd'un accées refusé, donc vous ne pouvez pas ni renommer,ni ouvrir, ni écrire,ni lire,ni supprimer ce dossier '--------------------------------------------Description in English --------------------------------------------'How to create a folder and protect it by password with vbscript © Hackoo August 2011'This vbscript creates a folder named "Protection" then he gives permission'access denied, so you can not rename or open, or write, or read or delete this folder'---------------------------------------------------------------------------------------------------------------'-------------------------------------------Programme Principal-------------------------------------------- Set fso = CreateObject("Scripting.FileSystemObject") Titre=" Protection Dossier © Hackoo © 2011 " If RegExists("HKLM\Software\Protection\") Then Call InputPassword Else Call Setup_Password()end if
sub Bloquer()Set WshNetwork = CreateObject("WScript.Network") NomMachine = WshNetwork.ComputerName NomUtilisateur = WshNetwork.UserNameSet objShell = CreateObject("Wscript.Shell")Set objFSO = CreateObject("Scripting.FileSystemObject")If objFSO.FolderExists("c:\Protection") ThenCommand1 = "%COMSPEC% /c attrib +s +h +r c:\Protection"Command2 = "%COMSPEC% /c Echo o| cacls c:\Protection /p " & qq(NomMachine) & ":n administrateurs:n" 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-DOSIf Result2 <> 0 Then MsgBox "Permissions sur le dossier non fait",16,"Permissions sur le dossier non fait"End Ifend ifEnd Sub sub Debloquer()Set WshNetwork = CreateObject("WScript.Network") NomMachine = WshNetwork.ComputerName NomUtilisateur = WshNetwork.UserNameSet objShell = CreateObject("Wscript.Shell")Set objFSO = CreateObject("Scripting.FileSystemObject")If objFSO.FolderExists("c:\Protection") ThenCommand1 = "%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-DOSIf Result <> 0 Then MsgBox "Permissions sur le dossier non fait",16,"Permissions sur le dossier non fait"End IfEnd if End Sub
Function qq(strIn) qq = Chr(34) & strIn & Chr(34)End Function
'---------------------------------Fonction Scramble--------------------------------------'Thanks to the Author of this Function © AMBience'C'est une Fonction de Cryptage trouvé dans ce lien:'http://www.visualbasicscript.com/Tiny-text-encryption-m83948.aspx' strText = String to encrypt\decrypt' lngSeed = Long number for the random seed (key)' Returns a string' To Encrypt:- Send the plain text with a positive seed number (1-2147483647)' To Decrypt:- Send the encrypted text with the same number but negativeFunction 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'-----------------------------------Fin de la Fonction Scramble--------------------------------------Function RegExists(value) On Error Resume Next Set WS = CreateObject("WScript.Shell") val = WS.RegRead(value) If (Err.number = -2147024893) or (Err.number = -2147024894) Then RegExists = False Else RegExists = True End If End Function '---------------------------------------------------------------------------------------------------- Sub Setup_Password()Dim Ws,Password,MDP,itemtype,LireMDPSet Ws = CreateObject("Wscript.Shell")Set FSO = CreateObject("Scripting.FileSystemObject")If Not FSO.FolderExists("c:\Protection") ThenFSO.CreateFolder ("c:\Protection")end ifMDP = "HKLM\Software\Protection\MDP"itemtype = "REG_SZ"VIDE=TrueWhile VIDEIf Password="" Then 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 = (intVertical+intHorizontal+700) / 2 '.Top = (intVertical+intHorizontal+570) / 2 .StatusBar = 0 .Width = 370 .Height = 250 .Visible = 1 .Resizable = 0 .MenuBar = 0 .Document.Title = "Setup du Mot de Passe © Hackoo ******" Dim strHTML : strHTML = "<center><h3 style='color:Red'>Choisisez Votre Mot de Passe</h3>" strHTML = strHTML &"<body bgcolor='#FFFFD2' scroll='no'>" strHTML = strHTML & "<input type='password' name='txt_Password1' size='30'>" strHTML = strHTML & "<h3 style='color:Red'>Retapez Votre Mot de Passe</h3>" strHTML = strHTML & "<input type='password' name='txt_Password2' size='30'><br>" strHTML = strHTML & "<br><button style='font-family:Verdana;font-size:14px;height:30px;Width:180px;' id='btn_Exit' onclick=" & Chr(34)& "VBScript:me.Value='Enregistrement....'" & Chr(34)& " title='Enregistrement....'>Envoyer</button></body></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 Password1=objExplorer.document.GetElementByID("txt_Password1").Value Password2=objExplorer.document.GetElementByID("txt_Password2").ValueIf Password1 = Password2 Then Password = objExplorer.document.GetElementByID("txt_Password2").Value PasswordCrypt = Scramble(Password,2011) MsgBox "Votre Mot de Passe Crypté est: " & PasswordCrypt ,64,"Mot de Passe Crypté" Msgbox "VOTRE MOT DE PASSE EN CLAIR EST ""{"&Password&"}"" SAUVEGARDER LE BIEN ! C'EST LE SEUL MOYEN POUR DEBLOQUER LE DOSSIER PROTECTION!",64,"MOT DE PASSE INSTALLE Hackoo © 2011 !" else MsgBox "Les Deux mots de passe ne sont pas identiques" ,16,"Mot de Passe Erroné !" end if If Password <>"" Then VIDE=False Ws.RegWrite MDP, PasswordCrypt, itemtype Call Bloquer() Set Voix = CreateObject("SAPI.Spvoice") Voix.Speak "Folder Protection Created and Protected Sucessfully and of course you can copy your folders and files in it to protect them !" MsgBox "Le Dossier Protection est désormais créé et protégé avec succès ! et vous pouvez copier vos dossiers et vos fichiers dans ce dernier pour les protéger !"& vbCrLf&_ "Folder Protection Created and Protected Sucessfully ! and of course you can copy your folders and files in it to protect them !",64,Titre End if End if objExplorer.Quit Set objExplorer = NothingWendend Sub
'--------------------------------InputPassword-------------------------Sub InputPassword()Const ForWriting = 2Const ForAppending = 8Dim Ws,Password,MDP,itemtype,LireMDPTitre=" Protection Dossier © Hackoo © 2011 "Set Ws = CreateObject("Wscript.Shell")Set FSO = CreateObject("Scripting.FileSystemObject")MDP = "HKLM\Software\Protection\MDP"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-300) / 2 .StatusBar = 0 .Width = 320 .Height = 175 .Visible = 1 .Resizable = 0 .MenuBar = 0 .Document.Title = "Mot de Passe © Hackoo ****** " Dim strHTML : strHTML = "<center><body bgcolor='#000000' text='#Green' ><h3 style='color:Red'>Entrez Votre Mot de Passe</h3>" strHTML = strHTML &"<body bgcolor='#FFFFD2' scroll='no'>" strHTML = strHTML & "<input type='password' name='txt_Password' size='30'><br>" strHTML = strHTML & "<br><button style='font-family:Verdana;font-size:14px;height:30px;Width:180px;' id='btn_Exit' onclick=" & Chr(34)& "VBScript:me.Value='AUTENTIFICATION...'" & Chr(34)& " title='Vérifier le mot de passe...'>Envoyer</button></body></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 = objExplorer.document.GetElementByID("txt_Password").Value PassowrdCrypt = Scramble(Password,2011) objExplorer.Quit Set objExplorer = Nothing
If RegExists(MDP) Then LireMDP = ws.RegRead(MDP) LireMDP = Scramble(LireMDP,-2011)If Password = LireMDP thenQuestion = MsgBox ("Voulez-vous accéder à votre Dossier protégé ?",VBYesNO+VbQuestion,Titre) If Question = VbYes then Call Debloquer() Explorer("c:\Protection") else Call Bloquer end ifelse Call Bloquer Set Voix = CreateObject("SAPI.Spvoice") Voix.Speak "Password incorrect; and Permission Denied." Msgbox "MOT DE PASSE INCORRECT VOUS N'AVEZ PAS LE DROIT D'ACCEDER A CE DOSSIER !",16,"MOT DE PASSE INCORRECT Hackoo © 2011 !"end ifend ifend sub'--------------------Fin du InputPassword-------------
Function Explorer(File) Set ws=CreateObject("wscript.shell") ws.run "Explorer "& File & "\"end Function If you can't easily copy and paste this source code,So here in this
link you can