A. Kalender Javascript.
Contoh :"Kalender.HTA"
B. Pembilang Angka.
C. Javascript Date Kalkulator.
D. Simple Text Counter.
E. HTML Text Area ON Focus Blur.
<html>Simpan Dengan Ekstensi ".HTA"
<head>
<title>Jam & Kalender Digital</title>
<script type='text/javascript'>
sW = screen.width;
sH = screen.height;
window.moveTo(sW, sH);
window.resizeTo(464, 450);
</script>
<hta:application
applicationName="jam&kalender"
border="thin"
contextMenu="no"
icon="kalender.ico"
id="3626:11010101101011"
innerBorder="no"
maximizeButton="no"
scroll="no"
selection="no"
singleInstance="yes"
version="3.6.2.6"/>
<meta http-equiv='MSThemeCompatible' content='yes'/>
<style type='text/css'>
table {
width: 464px;
height: 450px;
font-family: arial;
font-weight: bold;
font-size: 14px;
cursor: default;
}
td {
width: 64px;
height: 32px;
background-color: #f5f5f5;
text-align: center;
}
input {
width: 28px;
height: 24px;
font-family: arial;
font-weight: normal;
font-size: 14px;
cursor: pointer;
}
.myh {
width: 196px;
font-size: 16px;
color: #ff9000;
}
.dy,.dyh {
color: #0000ff;
}
.jm,.jmh {
color: #009f00;
}
.st,.sth {
color: #bf00cf;
}
.mg,.mgh {
color: #ff0000;
}
.dy,.jm,.st,.mg {
height: 64px;
font-size: 12px;
}
.dyh,.jmh,.sth,.mgh {
font-size: 14px;
}
.clk {
width: 196px;
height: 64px;
font-size: 44px;
color: #00afff;
}
.dte {
width: 130px;
font-size: 16px;
color: #ff00cf;
};
</style>
</head>
<body topMargin='0' leftMargin='0' onSelectStart='return false;' onContextMenu='return false;'>
<table border='1' borderColor='#808080' cellSpacing='0' cellPadding='0'>
<tr>
<td colSpan='2' style='width:130px;'>
<input type='button' onClick='chgMth(0,100);' title='-100 Tahun' value='<<'/>
<input type='button' onClick='chgMth(0,10);' title='-10 Tahun' value='<<'/>
<input type='button' onClick='chgMth(0,1);' title='-1 Tahun' value='<<'/>
<input type='button' onClick='chgMth(1,0);' title='-1 Bulan' value='<<'/>
</td>
<td colSpan='3' class='myh' id='mTyR'/>
<td colSpan='2' style='width:130px;'>
<input type='button' onClick='chgMth(3,0);' title='+1 Bulan' value='>>'/>
<input type='button' onClick='chgMth(4,1);' title='+1 Tahun' value='>>'/>
<input type='button' onClick='chgMth(4,10);' title='+10 Tahun' value='>>'/>
<input type='button' onClick='chgMth(4,100);' title='+100 Tahun' value='>>'/>
</td>
</tr>
<tr>
<td class='mgh'>Minggu</td>
<td class='dyh'>Senin</td>
<td class='dyh'>Selasa</td>
<td class='dyh'>Rabu</td>
<td class='dyh'>Kamis</td>
<td class='jmh'>Jum'at</td>
<td class='sth'>Sabtu</td>
</tr>
<tr>
<td colSpan='1' class='mg' id='iD0'/>
<td colSpan='1' class='dy' id='iD1'/>
<td colSpan='1' class='dy' id='iD2'/>
<td colSpan='1' class='dy' id='iD3'/>
<td colSpan='1' class='dy' id='iD4'/>
<td colSpan='1' class='jm' id='iD5'/>
<td colSpan='1' class='st' id='iD6'/>
</tr>
<tr>
<td colSpan='1' class='mg' id='iD7'/>
<td colSpan='1' class='dy' id='iD8'/>
<td colSpan='1' class='dy' id='iD9'/>
<td colSpan='1' class='dy' id='iD10'/>
<td colSpan='1' class='dy' id='iD11'/>
<td colSpan='1' class='jm' id='iD12'/>
<td colSpan='1' class='st' id='iD13'/>
</tr>
<tr>
<td colSpan='1' class='mg' id='iD14'/>
<td colSpan='1' class='dy' id='iD15'/>
<td colSpan='1' class='dy' id='iD16'/>
<td colSpan='1' class='dy' id='iD17'/>
<td colSpan='1' class='dy' id='iD18'/>
<td colSpan='1' class='jm' id='iD19'/>
<td colSpan='1' class='st' id='iD20'/>
</tr>
<tr>
<td colSpan='1' class='mg' id='iD21'/>
<td colSpan='1' class='dy' id='iD22'/>
<td colSpan='1' class='dy' id='iD23'/>
<td colSpan='1' class='dy' id='iD24'/>
<td colSpan='1' class='dy' id='iD25'/>
<td colSpan='1' class='jm' id='iD26'/>
<td colSpan='1' class='st' id='iD27'/>
</tr>
<tr>
<td colSpan='1' class='mg' id='iD28'/>
<td colSpan='1' class='dy' id='iD29'/>
<td colSpan='1' class='dy' id='iD30'/>
<td colSpan='1' class='dy' id='iD31'/>
<td colSpan='1' class='dy' id='iD32'/>
<td colSpan='1' class='jm' id='iD33'/>
<td colSpan='1' class='st' id='iD34'/>
</tr>
<tr>
<td colSpan='1' rowSpan='2' class='mg' id='iD35'/>
<td colSpan='1' rowSpan='2' class='dy' id='iD36'/>
<td colSpan='3' rowSpan='2' class='clk' id='showClock'/>
<td colSpan='2' class='dte' id='showDate'/>
</tr>
<tr>
<td colSpan='2' class='dte' style='color:#00cf00;' id='showDay'/>
</tr>
</table>
</body>
<script type='text/javascript'>
dN = ["Minggu", "Senin", "Selasa", "Rabu", "Kamis", "Jum'at", "Sabtu"];
mN = ["Januari", "Februari", "Maret", "April", "Mei", "Juni", "Juli", "Agustus", "September", "Oktober", "Nopember", "Desember"];
pN = ["Legi", "Pahing", "Pon", "Wage", "Kliwon"];
iW = (464 + (464 - document.body.offsetWidth));
iH = (450 + (450 - document.body.offsetHeight));
chgMth(2, 0); chgClk();
document.body.focus(); window.resizeTo(iW, iH);
window.moveTo(((sW - iW) / 2), ((sH - iH) / 2));
function chgMth(i, y) {
dT = new Date();
if (i == 0) {
yR -= y;
if (yR < 100) {
yR = 100;
};
};
if (i == 1) {
if (mT > 0) {
mT--;
} else {
if (yR == 100) {
mT = 0;
} else {
mT = 11;
yR--;
};
};
};
if (i == 2) {
mT = dT.getMonth();
yR = dT.getFullYear();
};
if (i == 3) {
if (mT < 11) {
mT++;
} else {
if (yR == 250000) {
mT = 11;
} else {
mT = 0;
yR++;
};
};
};
if (i == 4) {
yR += y;
if (yR > 250000) {
yR = 250000;
};
};
for (cN = 0; cN <= 36; cN++) {
document.getElementById("iD" + cN).style.backgroundColor = "#dcdcff";
};
cN = new Date(yR, mT, 1).getDay();
for (dY = new Date(yR, mT, 0).getDate() - (cN - 1), bI = 0; bI < cN; dY++, bI++) {
document.getElementById("iD" + bI).innerHTML = "<font style='font-size:20px;color:#808080;'>" + dY + "</font>";
};
for (dY = 1; dY <= new Date(yR, (mT + 1), 0).getDate(); dY++, cN++) {
pS = (((new Date(yR, mT, dY).getTime() - new Date(100, 0, 1).getTime()) / (24 * 60 * 60 * 1000)) % 5);
document.getElementById("iD" + cN).innerHTML = "<font style='font-size:28px;'>" + dY + "</font><br/>" + pN[pS];
if (dY == dT.getDate() & mT == dT.getMonth() & yR == dT.getFullYear()) {
document.getElementById("iD" + cN).style.backgroundColor = "#ffff88";
};
};
for (dY = 1; cN <= 36; dY++, cN++) {
document.getElementById("iD" + cN).innerHTML = "<font style='font-size:20px;color:#808080;'>" + dY + "</font>";
};
mTyR.innerHTML = "<font onClick='chgMth(2,0);' style='cursor:pointer;' title='" + mN[dT.getMonth()] + " " + dT.getFullYear() + "'>" + mN[mT] + " " + yR + "</font>";
};
function chgClk() {
dTcL = new Date();
hRcL = dTcL.getHours();
mNcL = dTcL.getMinutes();
sCcL = dTcL.getSeconds();
dYcL = dTcL.getDate();
mTcL = dTcL.getMonth();
yRcL = dTcL.getFullYear();
if (mTcL == 7) {
mMcL = "Ags";
} else {
mMcL = mN[mTcL].substr(0, 3);
};
if (dYcL < 10) {
dYcL = "0" + dYcL;
};
if (hRcL < 10) {
hRcL = "0" + hRcL;
};
if (mNcL < 10) {
mNcL = "0" + mNcL;
};
if (sCcL < 10) {
sCcL = "0" + sCcL;
};
if (showDate.innerHTML != dYcL + " " + mMcL + " " + yRcL) {
chgMth(5, 0);
};
pScL = (((new Date(yRcL, mTcL, dYcL).getTime() - new Date(100, 0, 1).getTime()) / (24 * 60 * 60 * 1000)) % 5);
showClock.innerHTML = hRcL + ":" + mNcL + ":" + sCcL;
showDate.innerHTML = dYcL + " " + mMcL + " " + yRcL;
showDay.innerHTML = dN[dTcL.getDay()] + " " + pN[pScL];
setTimeout("chgClk();", 50);
};
</script>
</html>
Contoh :"Kalender.HTA"
B. Pembilang Angka.
<style type='text/css'>Simpan dengan Extensi ".HTA"
div.num2txt{
font-family:arial;
font-weight:bold;
font-size:10pt;
}
</style>
<center><b>Indonesia: </b><text>Ini adalah alat untuk membilang nilai angka.</text><br/>
<body><table width='285px' height='265px' bgcolor='#ffffff' border='1' bordercolor='#000000' cellpadding='0' cellspacing='1'>
<tr height='35px'><td width='60px'><div align='center' class='num2txt'>Angka</div></td><td><center><input type='text' id='agk' style='width:202px' maxlength='15'></center></td></tr>
<tr height='35px'><td colspan='2'><center><button style='height:25px;width:130px;cursor:pointer;' language='javascript' onclick='convert(agk.value,"id")'>Bilang</button>
<button style='height:25px;width:130px;cursor:pointer;' language='javascript' onclick='reset("id")'>Atur Ulang</button></center></td></tr>
<tr><td colspan='2'><center><textarea id='showhasil' style='resize:none;' readonly cols='30' rows='10'>Hasil...</textarea>
</center></td></tr></table><br/><br/>
<b>English: </b><text>This script will convert number into text.</text><br/>
<table width='285px' height='265px' bgcolor='#ffffff' border='1' bordercolor='#000000' cellpadding='0' cellspacing='1'>
<tr height='35px'><td width='60px'><div align='center' class='num2txt'>Number</div></td><td><center><input type='text' id='nmb' style='width:202px' maxlength='15'></center></td></tr>
<tr height='35px'><td colspan='2'><center><button style='height:25px;width:130px;cursor:pointer;' language='javascript' onclick='convert(nmb.value,"en")'>Say It</button>
<button style='height:25px;width:130px;cursor:pointer;' language='javascript' onclick='reset("en")'>Reset</button></center></td></tr>
<tr><td colspan='2'><center><textarea id='showresult' style='resize:none;' readonly cols='30' rows='10'>Result...</textarea></center>
</td></tr></table></body></center>
<SCRIPT LANGUAGE='JavaScript'>
function convert(val,lng){
var nm=String(val);
if(lng=="en"){inpt=document.getElementById("nmb");rslt=document.getElementById("showresult");}
if(lng=="id"){inpt=document.getElementById("agk");rslt=document.getElementById("showhasil");}
if(nm==""){nm="0";inpt.value="0";}
if(isNaN(nm)==true){nm=nm.replace(/[^0-9]/g,"");inpt.value=nm;}
while(nm.substring(0,1)=="0"&&nm.length>1){nm=nm.substring(1,nm.length);inpt.value=nm;}
if(nm==0){if(lng=="id"){zr="Nol."}else{zr="Zero."}rslt.value=zr;inpt.value="0";
}else{
if(lng=="id"){var hsl=String(bilang(nm));}
if(lng=="en"){var hsl=String(say(nm));}
hsl=(hsl.substring(0,1).toUpperCase()+hsl.substring(1,hsl.length)+".").replace(" .",".");
rslt.value=hsl;}}
function bilang(n){
var s=["","satu","dua","tiga","empat","lima","enam","tujuh","delapan","sembilan"];
var p=new Array(6);p[1]="puluh";p[2]="ratus";p[3]="ribu";p[6]="juta";p[9]="milyar";p[12]="triliyun";
while(n.substring(0,1)==0&&n.length>1){n=n.substring(1,n.length);}
if(n==""){return "";}
if(n.length==1){return s[(n)];}
if(String(n).substring(0,1)=="1"&n.length>1){var f="se";}else{var f=s[n.substring(0,1)]+" ";}
if(n.length==2){
if(n.substring(0,1)==1&n.substring(n.length,n.length-1)>0){
if(n.substring(n.length,n.length-1)==1){
return "sebelas";}else{return s[n.substring(1,2)]+" belas";}
}else{return f+p[n.length-1]+" "+s[n.substring(1,2)];}
}else if(n.length==3|n.length==4){
return f+p[n.length-1]+" "+bilang(n.substring(1,n.length));}else{t=(1+(n.length-1)%(3));
return (bilang(n.substring(0,t))+" "+p[n.length-t]+" "+bilang(n.substring(t,n.length))).replace(/ /g," ");}}
function say(n){
var s=["","one","two","three","four","five","six","seven","eight","nine"];
var i=["twen","thir","for","fif", "six","seven","eigh","nine"];
var p=new Array(5);p[2]="hundred";p[3]="thousand";p[6]="million";p[9]="billion";p[12]="trillion";
while(n.substring(0,1)==0&&n.length>1){n=n.substring(1,n.length);}
if(n==""){return "";}
if(n.length==1){return s[n];}
if(n.length==2){
if(n.substring(0,1)==1){
if(n.substring(1,2)==0){return "ten";}
if(n.substring(1,2)==1){return "eleven";}
if(n.substring(1,2)==2){return "tweleve";}else{return i[n.substring(1,2)-2]+"teen";}
}else{return i[n.substring(0,1)-2]+"ty "+s[n.substring(n.length,n.length-1)];}
}else if(n.length==3|n.length==4){
return s[n.substring(0,1)]+" "+p[n.length-1]+" "+say(n.substring(1,n.length));}else{t=(1+(n.length-1)%(3));
return (say(n.substring(0,t))+" "+p[n.length-t]+" "+say(n.substring(t,n.length))).replace(/ /g," ");}}
function reset(lng){
if(lng=="en"){inpt=document.getElementById("nmb");rslt=document.getElementById("showresult");}
if(lng=="id"){inpt=document.getElementById("agk");rslt=document.getElementById("showhasil");}
inpt.value=inpt.defaultValue;
rslt.value=rslt.defaultValue;}
</SCRIPT>
C. Javascript Date Kalkulator.
<table align='center' cellspacing='2px'><tr>Simpan dengan Extensi.HTA.
<td align='left' id='dd1'></td><td id='mm1'></td><td id='yy1'></td>
<td><div style='font-family:arial;font-weight:bold;font-size:12pt'>TO</div></td>
<td id='dd2'></td><td id='mm2'></td><td align='right' id='yy2'></td>
<tr><td colspan='7'><input type='text' ReadOnly style='width:100%;' id='result' value='Total 0 day(s)'>
</td></tr></table>
<script language='JavaScript'>
var e="getElementById"
var h="innerHTML"
var i="selectedIndex"
build("d",1,31);
build("m",1,12);
build("y",1900,2099);
var dt=new(Date);
d1[i]=(dt.getDate()-1);
m1[i]=dt.getMonth();
y1[i]=(dt.getFullYear()-1900);
d2[i]=d1[i];m2[i]=m1[i];y2[i]=y1[i];
function count(){
from=new Date((y1[i]+1900),m1[i],(d1[i]+1));
to=new Date((y2[i]+1900),m2[i],(d2[i]+1));
result.value="Total "+Math.round((to-from)/(1000*60*60*24))+" day(s)";}
function build(n,c,w){
var bdy="onchange='count()'>";
while(c<=w){bdy=bdy+"<option>"+c+"</option>";c=(c+1)};
document[e](n+n+"1")[h]="<select id='"+n+"1' "+bdy+"</select>";
document[e](n+n+"2")[h]="<select id='"+n+"2' "+bdy+"</select>";}
</script>
D. Simple Text Counter.
<HTML><HEAD>Simpan Dengan Extensi HTA.
<TITLE>Text Counter</TITLE>
<HTA:APPLICATION
APPLICATIONNAME="TEXT_COUNTER"
ID="TXT1234567890CTR"
VERSION="1.0.3.1"
BORDER="THIN"
BORDERSTYLE="NORMAL"
INNERBORDER="NO"
MAXIMIZEBUTTON="NO"
SCROLL="NO"
SINGLEINSTANCE="YES"
SELECTION="no"/></HEAD><CENTER><BODY><TABLE WIDTH="410px" HEIGHT="250px">
<TR><TD COLSPAN="3"><TEXTAREA STYLE="RESIZE:none;WIDTH:100%;HEIGHT:100%" WRAP="OFF" ID="input"></TEXTAREA></TD></TR>
<TR><TD COLSPAN="3" HEIGHT="25px"><INPUT TYPE="TEXT" STYLE="WIDTH:100%;HEIGHT:100%" VALUE="Total Character(s) : " ReadOnly ID="result"></TD></TR>
<TR><TD WIDTH="138px" HEIGHT="25px"><INPUT TYPE="BUTTON" STYLE="WIDTH:100%;HEIGHT:100%" VALUE="Count All" LANGUAGE="JavaScript" ONCLICK=count_all()></TD>
<TD WIDTH="138px" HEIGHT="25px"><INPUT TYPE="BUTTON" STYLE="WIDTH:100%;HEIGHT:100%" VALUE="Count Without Space" LANGUAGE="JavaScript" ONCLICK=count_space()></TD>
<TD WIDTH="136px" HEIGHT="25px"><INPUT TYPE="BUTTON" VALUE="Reset" STYLE="WIDTH:100%;HEIGHT:100%" LANGUAGE="JavaScript" ONCLICK=reset()></TD></TR></TABLE></BODY></CENTER>
<SCRIPT LANGUAGE="JavaScript">
function count_all(){
result.value="Total Character(s) : "+(input.value).replace(/[\n\r]/g,"").length
}
function count_space(){
result.value="Total Character(s) : "+((input.value).replace(/ /g,"")).replace(/[\n\r]/g,"").length
}
function reset(){
input.value=""
result.value="Total Character(s) : "
}
</SCRIPT></HTML>
E. HTML Text Area ON Focus Blur.
<SCRIPT LANGUAGE='JavaScript'>F. Membuat Folder Locker dari HTA
function OnAction(){
if(text.value==""){
text.value=text.defaultValue
text.style.color="gray"
}else if(text.value==text.defaultValue){
text.value=""
text.style.color="black"
}
}
</SCRIPT>
<TEXTAREA ID='text' LANGUAGE='JavaScript' STYLE='resize:none;color:gray;' OnFocus='OnAction()' OnBlur='OnAction()' COLS='50' ROWS='10'>Apa yang Anda pikirkan?</TEXTAREA>
<HTML><HEAD>G. Membuat Folder Locker dari VBS.
<TITLE>Folder Locker</TITLE>
<SCRIPT LANGUAGE="VBScript">Self.MoveTo Screen.Width,Screen.Height</SCRIPT>
<HTA:APPLICATION
APPLICATIONNAME="Folder-Locker"
VERSION="5.7.9.5"
BORDER="THIN"
BORDERSTYLE="NORMAL"
ICON="Locker.ico"
INNERBORDER="NO"
MAXIMIZEBUTTON="NO"
MINIMIZEBUTTON="NO"
SCROLL="NO"
SELECTION="NO"
SINGLEINSTANCE="YES"/>
<META HTTP-EQUIV='MSThemeCompatible' CONTENT='YES'>
</HEAD>
<BODY ID='ONSCR' LEFTMARGIN='0' TOPMARGIN='0'></BODY>
<SCRIPT LANGUAGE='VBScript'>
ON ERROR RESUME NEXT
DIM CBtn,FileFolder,FolderName,HsfReg,LockFolder,NameFile,ObjFSO,PassFile,WshShell
SET ObjFSO=CreateObject("Scripting.FileSystemObject")
SET WshShell=CreateObject("WScript.Shell")
FileFolder="\ "
LockFolder=FileFolder&"\ "
NameFile=FileFolder&"\ "
PassFile=FileFolder&"\ "
HsfReg="HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ShowSuperHidden"
IF ObjFSO.FileExists(NameFile) THEN FolderName=Decrypt(ObjFSO.OpenTextFile(NameFile,1,TRUE,TRUE).ReadLine)
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
IF WshShell.RegRead(HsfReg)<>"0" THEN WshShell.RegWrite(HsfReg),"0","REG_DWORD"
IF NOT ObjFSO.FolderExists(FolderName) AND NOT ObjFSO.FolderExists(LockFolder) THEN
CBtn="Self.Close" : CALL NF
ElseIF NOT ObjFSO.FileExists(PassFile) THEN CBtn="Self.Close" : CALL PS
ElseIF ObjFSO.FolderExists(LockFolder) THEN CBtn="MM" : CALL UL
ElseIF ObjFSO.FolderExists(FolderName) THEN CBtn="MM" : CALL MM
END IF
FUNCTION Clean(TEXT)
ON ERROR RESUME NEXT
Chars=Array("\","/",":","*","?","""","<",">","|")
For each Replaced in Chars
TEXT=Replace(TEXT,Replaced,"")
NEXT
Clean=TEXT
END FUNCTION
FUNCTION Decrypt(TEXT)
ON ERROR RESUME NEXT
FOR I=1 TO LEN(TEXT)
X=MID(TEXT,I,1)
TMP=TMP&CHRW(ASCW(X)-(50+I))
Next
Decrypt=TMP
End Function
FUNCTION Encrypt(TEXT)
ON ERROR RESUME NEXT
FOR I=1 TO LEN(TEXT)
X=MID(TEXT,I,1)
TMP=TMP&CHRW(ASCW(X)+(50+I))
Next
Encrypt=TMP
End Function
SUB InnerWindowSize(intWidth,intHeight)
ON ERROR RESUME NEXT
Self.ResizeTo intWidth,intHeight
Self.ResizeTo intWidth+(intWidth-Document.Body.OffsetWidth),intHeight+(intHeight-Document.Body.OffsetHeight)
Self.MoveTo (Screen.Width/2)-(intWidth/2),(Screen.Height/2)-(intHeight/2)
END SUB
SUB Lock
ON ERROR RESUME NEXT
DIM FolderName
FolderName=Decrypt(ObjFSO.OpenTextFile(NameFile,1,TRUE,TRUE).ReadLine)
ObjFSO.MoveFolder(FolderName),(LockFolder)
ObjFSO.GetFolder(LockFolder).attributes=39
IF ObjFSO.FolderExists(FolderName) THEN
MsgBox "Gagal mengunci folder."&vbNewLine&"Simpan data lalu tutup semua aplikasi yang menggunakan folder ini, lalu coba lagi.",16,"Folder Locker"
EXIT SUB
END IF
MsgBox "Folder berhasil dikunci",64,"Folder Locker"
Self.Close
END SUB
SUB MakeFolder
ON ERROR RESUME NEXT
DIM NewName
NewName=NameFolder.Value
IF (NewName)<>"" THEN
NewName=Clean(NewName)
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
MsgBox "Gagal membuat folder baru."&vbNewLine&"Folder dengan nama yang sama sudah ada di direktori ini."&vbNewLine&"Cobalah nama yang lain.",16,"Folder Locker"
NameFolder.Select
EXIT SUB
END IF
IF NOT ObjFSO.FolderExists(NewName) THEN
MsgBox "Gagal membuat folder baru",16,"Folder Locker"
NameFolder.Select
EXIT SUB
END IF
IF ObjFSO.FileExists(NameFile) THEN
ObjFSO.GetFile(NameFile).attributes=0
ObjFSO.DeleteFile(NameFile),TRUE
END IF
NewName=Encrypt(NewName)
ObjFSO.CreateTextFile(NameFile,TRUE,TRUE).Write(NewName)
ObjFSO.GetFile(NameFile).attributes=39
MsgBox "Folder baru berhasil dibuat",64,"Folder Locker"
CALL PS
ELSE
MsgBox "Nama folder tidak boleh kosong !!!",48,"Folder Locker"
NameFolder.Select
EXIT SUB
END IF
END SUB
SUB MM
ON ERROR RESUME NEXT
CALL InnerWindowSize(200,234)
ONSCR.InnerHTML="<TABLE HEIGHT='234px' WIDTH='200px' CELLSPACING='0' CELLPADDING='0'>"_
&"<TR BGCOLOR='#346E99' HEIGHT='45px'><TD><CENTER><FONT COLOR='#FFFFFF' SIZE='+2' FACE='VERDANA,ARIAL,HELVETICA,SANS-SERIF'>MENU UTAMA</FONT></CENTER></TD></TR>"_
&"<TR BGCOLOR='#BBBFFF'><TD><CENTER><BUTTON STYLE='HEIGHT:25px;WIDTH:165px' ONCLICK='Lock'>Kunci Folder</BUTTON><P/>"_
&"<BUTTON STYLE='HEIGHT:25px;WIDTH:165px' ONCLICK='RN'>Ubah Nama Folder</BUTTON><P/>"_
&"<BUTTON STYLE='HEIGHT:25px;WIDTH:165px' ONCLICK='PS'>Ganti Password</BUTTON><P/>"_
&"<BUTTON STYLE='HEIGHT:25px;WIDTH:165px' ONCLICK='Self.Close'>Keluar</BUTTON>"_
&"</TD></CENTER></TR></TABLE>"
END SUB
SUB NF
ON ERROR RESUME NEXT
CALL InnerWindowSize(272,116)
ONSCR.InnerHTML="<TABLE HEIGHT='116px' WIDTH='272px' BGCOLOR='#FFFFFF'>"_
&"<TR><TD><CENTER><TEXT>Tulis nama untuk folder baru</TEXT><BR/><INPUT TYPE='TEXT' NAME='NameFolder' SIZE='35' MaxLength='50'><P/>"_
&"<BUTTON TYPE='SUBMIT' STYLE='WIDTH:90px' ONCLICK='MakeFolder'>Buat</BUTTON> "_
&"<BUTTON STYLE='WIDTH:90px' ONCLICK='Self.Close'>Batal</BUTTON></CENTER></TD></TR>"
NameFolder.Select
END SUB
SUB Password
ON ERROR RESUME NEXT
DIM Password1,Password2
Password1=NewPassword.Value
Password2=VerifyPassword.Value
ON ERROR RESUME NEXT
IF (Password1)<>"" AND (Password2)="" THEN VerifyPassword.Select : EXIT SUB : END IF
IF (Password1)<>"" AND (Password2)<>"" THEN
IF (Password1)=(Password2) THEN
Password2=Encrypt(Password2)
IF ObjFSO.FileExists(PassFile) THEN
ObjFSO.GetFile(PassFile).attributes=0
ObjFSO.DeleteFile(PassFile),TRUE
END IF
ObjFSO.CreateTextFile(PassFile,TRUE,TRUE).Write(Password2)
ObjFSO.GetFile(PassFile).attributes=39
MsgBox "Password baru telah disimpan",64,"Folder Locker"
CBtn="MM"
CALL MM
ELSE
MsgBox "Password tidak cocok !!!",16,"Folder Locker"
NewPassword.Value=""
VerifyPassword.Value=""
NewPassword.Select
EXIT SUB
END IF
ELSE
MsgBox "Password tidak boleh kosong !!!",48,"Folder Locker"
NewPassword.Select
EXIT SUB
END IF
END SUB
SUB PS
ON ERROR RESUME NEXT
CALL InnerWindowSize(272,160)
ONSCR.InnerHTML="<TABLE HEIGHT='160px' WIDTH='272px' BGCOLOR='#FFFFFF'>"_
&"<TR><TD><CENTER><TEXT>Tulis password baru</TEXT><BR/><INPUT TYPE='PASSWORD' NAME='NewPassword' SIZE='35'><BR/>"_
&"<TEXT>Tulis lagi password yang baru</TEXT><BR/><INPUT TYPE='PASSWORD' NAME='VerifyPassword' SIZE='35'><P/>"_
&"<BUTTON TYPE='SUBMIT' STYLE='WIDTH:90px' ONCLICK='Password'>Simpan</BUTTON> "_
&"<BUTTON STYLE='WIDTH:90px' ONCLICK='"&Cbtn&"'>Batal</BUTTON></CENTER></TD></TR>"
NewPassword.Select
END SUB
SUB Rename
ON ERROR RESUME NEXT
DIM FolderName,NewName
FolderName=Decrypt(ObjFSO.OpenTextFile(NameFile,1,TRUE,TRUE).ReadLine)
NewName=NameFolder.Value
IF (NewName)<>"" THEN
NewName=Clean(NewName)
IF ObjFSO.FolderExists(NewName) THEN
MsgBox "Gagal mengubah nama folder."&vbNewLine&"Folder dengan nama yang sama sudah ada di direktori ini."&vbNewLine&"Cobalah nama yang lain.",16,"Folder Locker"
NameFolder.Select
EXIT SUB
END IF
ObjFSO.MoveFolder(FolderName),(NewName)
IF NOT ObjFSO.FolderExists(NewName) THEN
MsgBox "Gagal mengubah nama folder",16,"Folder Locker"
NameFolder.Select
EXIT SUB
ELSE
IF ObjFSO.FileExists(NameFile) THEN
ObjFSO.GetFile(NameFile).attributes=0
ObjFSO.DeleteFile(NameFile),TRUE
END IF
NewName=Encrypt(NewName)
ObjFSO.CreateTextFile(NameFile,TRUE,TRUE).Write(NewName)
ObjFSO.GetFile(NameFile).attributes=39
MsgBox "Nama folder berhasil diganti",64,"Folder Locker"
CALL MM
END IF
ELSE
MsgBox "Nama folder tidak boleh kosong !!!",48,"Folder Locker"
NameFolder.Select
EXIT SUB
END IF
END SUB
SUB RN
ON ERROR RESUME NEXT
CALL InnerWindowSize(272,116)
ONSCR.InnerHTML="<TABLE HEIGHT='116px' WIDTH='272px' BGCOLOR='#FFFFFF'>"_
&"<TR><TD><CENTER><TEXT>Tulis nama baru untuk folder Anda</TEXT><BR/><INPUT TYPE='TEXT' NAME='NameFolder' SIZE='35' MaxLength='50'><P/>"_
&"<BUTTON TYPE='SUBMIT' STYLE='WIDTH:90px' ONCLICK='Rename'>Ubah Nama</BUTTON> "_
&"<BUTTON STYLE='WIDTH:90px' ONCLICK='MM'>Batal</BUTTON></CENTER></TD></TR>"
NameFolder.Select
END SUB
SUB UL
ON ERROR RESUME NEXT
CALL InnerWindowSize(272,116)
ONSCR.InnerHTML="<TABLE HEIGHT='116px' WIDTH='272px' BGCOLOR='#FFFFFF'>"_
&"<TR><TD><CENTER><TEXT>Tulis password untuk membuka folder</TEXT><BR/><INPUT TYPE='PASSWORD' NAME='PasswordInput' SIZE='35'><P/>"_
&"<BUTTON TYPE='SUBMIT' STYLE='WIDTH:90px' ONCLICK='Unlock'>Buka</BUTTON> "_
&"<BUTTON STYLE='WIDTH:90px' ONCLICK='Self.Close'>Batal</BUTTON></CENTER></TD></TR>"
PasswordInput.Select
END SUB
SUB Unlock
ON ERROR RESUME NEXT
DIM PASS,UserPassword
PASS=PasswordInput.Value
IF (PASS)<>"" THEN
UserPassword=Decrypt(ObjFSO.OpenTextFile(PassFile,1,TRUE,TRUE).ReadLine)
IF NOT (PASS)=(UserPassword) THEN
MsgBox "Password salah !!!",16,"Folder Locker"
PasswordInput.Value=""
PasswordInput.Select
EXIT SUB
ELSE
IF ObjFSO.FolderExists(FolderName) THEN
MsgBox "Gagal membuka folder",48,"Folder Locker"
Self.Close
ELSE
ObjFSO.GetFolder(LockFolder).attributes=9
ObjFSO.MoveFolder(LockFolder),(FolderName)
MsgBox "Folder berhasil dibuka",64,"Folder Locker"
WshShell.Run("explorer.exe "&FolderName)
Self.Close
END IF
END IF
ELSE
MsgBox "Password kosong !!!",48,"Folder Locker"
PasswordInput.Select
EXIT SUB
END IF
END SUB
</SCRIPT>
</HTML>
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
0 komentar:
Posting Komentar