File locker for FREE

COPY THIS SCRIPT TO NOTEPAD TO CREATE .VBS ...... it will make a locker for you 


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."&vbNewLine&"Some character is invalid.",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