Membuat Folder Locker dari Visual Basic Script (VBS)

Sebelumnya ane udah membahas soal "Membuat Folder Locker dari BATCH", nah, sekarang ane buat yang baru nih, kali ini bukan bahasa BATCH yang digunakan, tetapi bahasa Visual Basic Script (VBS),,, tetapi mungkin masih banyak kesalahan pengeditan, soalnya ane juga masih awam dalam bahasa VBScript, kalo ada yang nemu kesalahan tolong di fix ya, Ok, langsung aja, pertama2 copass semua script di bawah ini ke notepad, lalu save dengan extensi "*.VBS", caranya setelah nulis di notepad pilih save as, terus tambahin .vbs dibelakang nama file, dan ubah formatnya menjadi all files, lalu save deh...

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("Tulis nama untuk folder baru Anda :","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("Gagal membuat folder baru."&vbNewLine&"Folder dengan nama yang sama sudah ada di direktori ini."&vbNewLine&"Coba nama yang lain.",21,"Folder Locker"))=4 THEN CALL MakeFolder() ELSE WScript.Quit END IF END IF IF NOT ObjFSO.FolderExists(NewName) THEN IF (MsgBox("Gagal membuat folder baru."&vbNewLine&"Beberapa karakter tidak benar.",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 berhasil dibuat",64,"Folder Locker" CALL NewPass() WScript.Quit ELSE MsgBox "Nama folder tidak boleh kosong !!!",48,"Folder Locker" CALL MakeFolder() END IF END SUB SUB Rename() ON ERROR RESUME NEXT DIM NewName NewName=InputBox("Tulis nama baru untuk folder Anda :","Folder Locker") IF IsEmpty(NewName) THEN CALL Menu() IF (NewName)<>"" THEN IF ObjFSO.FolderExists(NewName) THEN IF (MsgBox("Gagal mengubah nama folder."&vbNewLine&"Folder dengan nama yang sama sudah ada di direktori ini."&vbNewLine&"Coba nama yang lain.",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("Gagal mengubah nama 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 "Berhasil mengubah nama folder",64,"Folder Locker" CALL Menu() END IF ELSE MsgBox "Nama folder tidak boleh kosong !!!",48,"Folder Locker" CALL Rename() END IF END SUB SUB VerifyUser() ON ERROR RESUME NEXT DIM PASS,UserPassword PASS=InputBox("Masukkan sandi Anda untuk membuka 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("Sandi salah !!!",21,"Folder Locker"))=4 THEN CALL VerifyUser() ELSE WScript.Quit END IF END IF ELSE MsgBox "Sandi kosong !!!",48,"Folder Locker" CALL VerifyUser() END IF END SUB SUB Unlock() ON ERROR RESUME NEXT IF ObjFSO.FolderExists(FolderName) THEN MsgBox "Gagal membuka folder",48,"Folder Locker" WScript.Quit ELSE ObjFSO.GetFolder(LockFolder).attributes=9 ObjFSO.MoveFolder(LockFolder),(FolderName) MsgBox "Folder berhasil dibuka",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("Masukkan sandi baru :","Folder Locker") IF IsEmpty(Password) THEN CALL Menu() IF (Password)<>"" THEN DIM NewPassword NewPassword=InputBox("Verifikasi sandi baru Anda :","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 "Sandi baru telah disimpan",64,"Folder Locker" CALL Menu() ELSE IF (MsgBox("Sandi tidak cocok !!!",21,"Folder Locker"))=4 THEN CALL ChangePass() ELSE CALL Menu() END IF END IF ELSE MsgBox "Sandi tidak boleh kosong !!!",48,"Folder Locker" CALL ChangePass() END IF END SUB SUB NewPass() ON ERROR RESUME NEXT DIM Password Password=InputBox("Masukkan sandi baru :","Folder Locker") IF IsEmpty(Password) THEN WScript.Quit IF (Password)<>"" THEN DIM NewPassword NewPassword=InputBox("Verifikasi sandi baru :","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 "Sandi baru telah disimpan",64,"Folder Locker" WScript.Quit ELSE IF (MsgBox("Sandi tidak cocok !!!",21,"Folder Locker"))=4 THEN CALL NewPass() ELSE WScript.Quit END IF END IF ELSE MsgBox "Sandi tidak boleh kosong !!!",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("Gagal mengunci folder."&vbNewLine&"Simpan semua data dan tutup semua aplikasi yang menggunakan folder ini, lalu coba lagi.",21,"Folder Locker"))=4 THEN CALL Lock() ELSE CALL Menu() END IF END IF MsgBox "Folder berhasil dikunci",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) Kunci Folder"&vbNewLine&"2) Ubah Nama Folder"&vbNewLine&"3) Ganti Sandi"&vbNewLine&""&vbNewLine&""&vbNewLine&"Masukkan pilihan Anda :","Folder Locker") IF IsEmpty(Choice) THEN WScript.Quit IF (Choice)="1" THEN IF (MsgBox("Kunci folder Anda lalu keluar ?",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 "Pilihan Salah !!!",16,"Folder Locker" CALL Menu() END SUB