Make Folder Locker with Visual Basic Script (VBS)

Previously I've talked about making a batch folder locker, now I make a version of Visual Basic Script (VBS), but my knowledge about VBS less than about BAT, if there are any problems found, please fix it, Ok, let's start, first Copy this script into notepad and save as "*.VBS" extension, ex:"Locker.vbs", after that, run the VBScript file and follow the wizard to make new folder and new password...

code: 

ON ERROR RESUME NEXT DIM FileFolder,FolderName,LockFolder,NameFile,ObjFSO,PassFile SET ObjFSO=CreateObject("Scripting.FileSystemObject") FileFolder="\C2F41D69-E2A7-5795-89B40080" LockFolder=FileFolder&"\D4E221D2-3A5B-1069-52CF0600" NameFile=FileFolder&"\E85D24D8-98F5-68C0-B28A0100" PassFile=FileFolder&"\F69CD1E2-B5C3-21A7-A94E0070" FolderName=ObjFSO.OpenTextFile(NameFile,1).ReadLine CALL Decrypt(FolderName) IF ObjFSO.FolderExists(FileFolder) THEN ObjFSO.GetFolder(FileFolder).attributes=39 IF ObjFSO.FolderExists(LockFolder) THEN ObjFSO.GetFolder(LockFolder).attributes=39 IF ObjFSO.FileExists(NameFile) THEN ObjFSO.GetFile(NameFile).attributes=39 IF ObjFSO.FileExists(PassFile) THEN ObjFSO.GetFile(PassFile).attributes=39 CreateObject("WScript.Shell").RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ShowSuperHidden",0,"REG_DWORD" IF NOT ObjFSO.FolderExists(FolderName) AND NOT ObjFSO.FolderExists(LockFolder) THEN CALL MakeFolder() ELSE IF NOT ObjFSO.FileExists(PassFile) THEN CALL NewPass() END IF IF ObjFSO.FolderExists(LockFolder) THEN CALL VerifyUser() CALL Unlock() END IF IF ObjFSO.FolderExists(FolderName) THEN CALL Menu() SUB MakeFolder() ON ERROR RESUME NEXT DIM NewName NewName=InputBox("Type new folder name :","Folder Locker") IF IsEmpty(NewName) THEN WScript.Quit IF (NewName)<>"" THEN IF NOT ObjFSO.FolderExists(FileFolder) THEN ObjFSO.CreateFolder(FileFolder) ObjFSO.GetFolder(FileFolder).attributes=39 END IF IF NOT ObjFSO.FolderExists(NewName) THEN ObjFSO.CreateFolder(NewName) ELSE IF(MsgBox("Unable to make a new folder."&vbNewLine&"Folder with same name is already exist in this directory."&vbNewLine&"Try another name.",21,"Folder Locker"))=4 THEN CALL MakeFolder() ELSE WScript.Quit END IF END IF IF NOT ObjFSO.FolderExists(NewName) THEN IF (MsgBox("Unable to make a new folder."&vbNewLine&"Some character is invalid.",21,"Folder Locker"))=4 THEN CALL MakeFolder() ELSE WScript.Quit END IF END IF IF ObjFSO.FileExists(NameFile) THEN ObjFSO.GetFile(NameFile).attributes=0 ObjFSO.DeleteFile(NameFile),TRUE END IF CALL Encrypt(NewName) ObjFSO.CreateTextFile(NameFile,TRUE).Write(NewName) ObjFSO.GetFile(NameFile).attributes=39 MsgBox "Folder created successfully",64,"Folder Locker" CALL NewPass() WScript.Quit ELSE MsgBox "Folder Name can't be empty !!!",48,"Folder Locker" CALL MakeFolder() END IF END SUB SUB Rename() ON ERROR RESUME NEXT DIM NewName NewName=InputBox("Type new name for your folder :","Folder Locker") IF IsEmpty(NewName) THEN CALL Menu() IF (NewName)<>"" THEN IF ObjFSO.FolderExists(NewName) THEN IF (MsgBox("Unable to rename folder."&vbNewLine&"Folder with same name is already exist in this directory."&vbNewLine&"Try another name.",21,"Folder Locker"))=4 THEN CALL Rename() ELSE CALL Menu() END IF END IF ObjFSO.MoveFolder(FolderName),(NewName) IF NOT ObjFSO.FolderExists(NewName) THEN IF (MsgBox("Unable to rename folder",21,"Folder Locker"))=4 THEN CALL Rename() ELSE CALL Menu() END IF ELSE IF ObjFSO.FileExists(NameFile) THEN ObjFSO.GetFile(NameFile).attributes=0 ObjFSO.DeleteFile(NameFile),TRUE END IF CALL Encrypt(NewName) ObjFSO.CreateTextFile(NameFile,TRUE).Write(NewName) ObjFSO.GetFile(NameFile).attributes=39 FolderName=ObjFSO.OpenTextFile(NameFile,1).ReadLine CALL Decrypt(FolderName) MsgBox "Folder renamed successfully",64,"Folder Locker" CALL Menu() END IF ELSE MsgBox "Folder name can't be empty !!!",48,"Folder Locker" CALL Rename() END IF END SUB SUB VerifyUser() ON ERROR RESUME NEXT DIM PASS,UserPassword PASS=InputBox("Type your password to unlock folder :","Folder Locker") IF IsEmpty(PASS) THEN WScript.Quit IF (PASS)<>"" THEN UserPassword=ObjFSO.OpenTextFile(PassFile,1).ReadLine CALL Decrypt(UserPassword) IF NOT (PASS)=(UserPassword) THEN IF (MsgBox("Wrong password !!!",21,"Folder Locker"))=4 THEN CALL VerifyUser() ELSE WScript.Quit END IF END IF ELSE MsgBox "Empty password !!!",48,"Folder Locker" CALL VerifyUser() END IF END SUB SUB Unlock() ON ERROR RESUME NEXT IF ObjFSO.FolderExists(FolderName) THEN MsgBox "Unable to unlock folder",48,"Folder Locker" WScript.Quit ELSE ObjFSO.GetFolder(LockFolder).attributes=9 ObjFSO.MoveFolder(LockFolder),(FolderName) MsgBox "Folder unlocked successfully",64,"Folder Locker" WScript.CreateObject("WScript.Shell").Run("explorer.exe "&FolderName) WScript.Quit END IF END SUB SUB ChangePass() ON ERROR RESUME NEXT DIM Password Password=InputBox("Type new password :","Folder Locker") IF IsEmpty(Password) THEN CALL Menu() IF (Password)<>"" THEN DIM NewPassword NewPassword=InputBox("Verify your new password :","Folder Locker") IF IsEmpty(NewPassword) THEN CALL Menu() IF (NewPassword)=(Password) THEN CALL Encrypt(NewPassword) IF ObjFSO.FileExists(PassFile) THEN ObjFSO.GetFile(PassFile).attributes=0 ObjFSO.DeleteFile(PassFile),TRUE END IF ObjFSO.CreateTextFile(PassFile,TRUE).Write(NewPassword) ObjFSO.GetFile(PassFile).attributes=39 MsgBox "New password has been saved",64,"Folder Locker" CALL Menu() ELSE IF (MsgBox("Password doesn't match !!!",21,"Folder Locker"))=4 THEN CALL ChangePass() ELSE CALL Menu() END IF END IF ELSE MsgBox "Password can't be empty !!!",48,"Folder Locker" CALL ChangePass() END IF END SUB SUB NewPass() ON ERROR RESUME NEXT DIM Password Password=InputBox("Type new password :","Folder Locker") IF IsEmpty(Password) THEN WScript.Quit IF (Password)<>"" THEN DIM NewPassword NewPassword=InputBox("Verify new password :","Folder Locker") IF IsEmpty(NewPassword) THEN WScript.Quit IF (NewPassword)=(Password) THEN CALL Encrypt(NewPassword) IF ObjFSO.FileExists(PassFile) THEN ObjFSO.GetFile(PassFile).attributes=0 ObjFSO.DeleteFile(PassFile),TRUE END IF ObjFSO.CreateTextFile(PassFile,TRUE).Write(NewPassword) ObjFSO.GetFile(PassFile).attributes=39 MsgBox "New password has been saved",64,"Folder Locker" WScript.Quit ELSE IF (MsgBox("Password doesn't match !!!",21,"Folder Locker"))=4 THEN CALL NewPass() ELSE WScript.Quit END IF END IF ELSE MsgBox "Password can't be empty !!!",48,"Folder Locker" CALL NewPass() END IF END SUB SUB Lock() ON ERROR RESUME NEXT ObjFSO.MoveFolder(FolderName),(LockFolder) ObjFSO.GetFolder(LockFolder).attributes=39 IF ObjFSO.FolderExists(FolderName) THEN IF (MsgBox("Unable to Lock folder."&vbNewLine&"Save all data and close all applications that use this folder, then try again.",21,"Folder Locker"))=4 THEN CALL Lock() ELSE CALL Menu() END IF END IF MsgBox "Folder Locked successfully",64,"Folder Locker" WScript.Quit END SUB SUB Encrypt(NewPassword) ON ERROR RESUME NEXT FOR i=1 TO LEN(NewPassword) X=MID(NewPassword,i,1) TMP=TMP & CHR(ASC(X)+50) & CHR(ASC(X)+99) NEXT NewPassword=TMP END SUB SUB Decrypt(UserPassword) ON ERROR RESUME NEXT FOR i=1 TO LEN(UserPassword) STEP 2 X=MID(UserPassword,i,1) TMP=TMP & CHR(ASC(X)-50) NEXT UserPassword=TMP END SUB SUB Encrypt(NewName) ON ERROR RESUME NEXT FOR i=1 TO LEN(NewName) X=MID(NewName,i,1) TMP=TMP & CHR(ASC(X)+50) & CHR(ASC(X)+99) NEXT NewName=TMP END SUB SUB Decrypt(FolderName) ON ERROR RESUME NEXT FOR i=1 TO LEN(FolderName) STEP 2 X=MID(FolderName,i,1) TMP=TMP & CHR(ASC(X)-50) NEXT FolderName=TMP END SUB SUB Menu() ON ERROR RESUME NEXT DIM Choice Choice=InputBox("1) Lock Folder"&vbNewLine&"2) Rename Folder"&vbNewLine&"3) Change Password"&vbNewLine&""&vbNewLine&""&vbNewLine&"Input your choice :","Folder Locker") IF IsEmpty(Choice) THEN WScript.Quit IF (Choice)="1" THEN IF (MsgBox("Lock your folder and exit ?",36,"Folder Locker"))=7 THEN CALL Menu() ELSE CALL Lock() END IF END IF IF (Choice)="2" THEN CALL Rename() IF (Choice)="3" THEN CALL ChangePass() MsgBox "Invalid input !!!",16,"Folder Locker" CALL Menu() END SUB