FSO的强大功能

代码如下:

<HTML> 
<HEAD> 
<TITLE>笨狼代码大管家</TITLE> 
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style> 
body 
{ 
font-size:12; 
BACKGROUND: #DADADA; 
margin-left:5; 
} 
.folder 
{ 
font-size:18; 
cursor:hand; 
} 
.folderIcon 
{ 
color:navy; 
font-family:wingdings; 
font-size:18; 
cursor:hand; 
} 
.file 
{ 
color:navy; 
font-size:18; 
cursor:hand; 
height:21; 
} 
.fileIcon 
{ 
color:navy; 
font-family:wingdings; 
font-size:18; 
cursor:hand; 
height:21; 
display:inline; 
} 
input 
{ 
width:20; 
overflow:visible; 
border:1px solid lightblue; 
background-color:#cccccc; 
cursor:text; 
} 
button 
{ 
border:1px solid gray; 
width:60; 
margin-left:2; 
cursor:hand; 
font-size:12; 
filter:progid:DXImageTransform.Microsoft.Gradient(startColorStr='#eaeaff', endColorStr='#618fff', gradientType='0'); 
} 
textarea 
{ 
font-family:Verdana; 
width:750; 
height:630; 
font-size:12px; 
overflow:scroll; 
} 
#frmTree 
{ 
WIDTH:200px; 
height:630; 
MARGIN: 0px; 
PADDING: 0px; 
overflow:scroll; 
MARGIN-right:10; 
} 
#frmSeach 
{ 
WIDTH:200px; 
height:630; 
MARGIN: 0px; 
PADDING: 0px; 
overflow:scroll; 
MARGIN-right:10; 
} 
#hide_control 
{ 
POSITION: absolute; 
LEFT:213px; 
TOP:10px; 
WIDTH:10px; 
height:630; 
BACKGROUND: #DADADA; 
padding-top:300; 
cursor:e-resize; 
border:1 solid gray; 
} 
#txtFrm 
{ 
POSITION: absolute; 
LEFT:230px; 
TOP:10px; 
WIDTH:100%; 
MARGIN: 0px; 
PADDING: 0px; 
BACKGROUND: #DADADA; 
} 
#tab1 
{ 
border:1 solid ; 
cursor:hand; 
} 
#tab2 
{ 
border:1 solid ; 
cursor:hand; 
BACKGROUND: gray; 
} 
#tab3 
{ 
border:1 solid; 
cursor:hand; 
BACKGROUND: gray; 
} 
#tab4 
{ 
border:1 solid ; 
cursor:hand; 
} 
</style> 
</HEAD> 
<BODY onselectstart="vbs:selectControl" onkeydown="vbs:shortCut"> 
<div id="frmTree" onclick="vbs:f_Click" onkeydown="vbs:deletFile" > 
<span id="tab1" >  目 录 </span> 
<span id="tab2" onclick="vbs:showMe frmSeach,frmTree">  搜 索 </span> 
<hr/> 
<div id="tree" style='margin-left:0;color:navy;font-size:12;cursor:hand;' ></div> 
</div> 
<div id="frmSeach" onclick="vbs:f_Click" > 
<span id="tab3" onclick="vbs:showMe frmTree,frmSeach" >  目 录 </span> 
<span id="tab4">  搜 索 </span> 
<hr/> 
<div id="list" style='margin-left:0' onkeydown="deletFile"> 
<input id="searchKey" style="width:100"/> 
<button onclick="vbs:seachFile" id="searchButton">查找</button><br/> 
<div id="seachList" style='margin-left:0' >搜索结果</div> 
</div> 
</div> 
<input type="button" id="hide_control" onmousedown="vbs:beginDrag" onmouseup="vbs:upHandler" bgcolor="#eeeeee"/> 
<div valign="top" id="txtFrm"> 
标题：<input id="articleTitle" style="width:100" readonly/> 
<button id="browse" onclick="vbs:browseMe" >预览</button> 
<button id="saveButton" onclick="vbs:saveFile" >保存</button> 
<button id="browse" onclick="vbs:createFile" >新建</button> 
<button id="test" onclick="vbs:showHelp">说明</button> 
行 <span id="Ln">1</span> 
<textarea id="txt" onkeydown='vbs:TabTxt' onclick="vbs:showLn"></textarea> 
</div>

<SCRIPT LANGUAGE="vbscript"> 
'************************** 
'*****超级大笨狼*********** 
'************************** 
on error resume next 
window.resizeTo window.screen.availWidth,window.screen.availHeight 
window.moveTo 0,0 
Set fso = CreateObject("Scripting.FileSystemObject") 
dim thisFileDir'定义本文件绝对路径 
dim thisFileName'定义本文件名 
dim thisFileFolder'定义本文件夹路径

thisFileDir = replace(window.location.href,"file:///","") 
thisFileDir = unescape(replace(thisFileDir,"/","\")) 
thisFileName = LastOne(thisFileDir,"\") 
thisFileFolder=getFolderDir(thisFileDir) 
tree.title = thisFileFolder 
dim currentDir'当前路径 
dim currentFile'当前文件 
dim currentDiv'当前DIV对象 
dim currentSpan'当前Span对象 
dim delatX 
dim dragAble:dragAble = false

currentDir = thisFileFolder 
set currentDiv = tree 
tree.innerText = getTxtName(thisFileName) 
showMe frmTree,frmSeach 
showFolder tree 
sub showLn 
Ln.innerText = cint((window.event.offsetY-2)/15)+1 
end sub 
sub shortCut 
if window.event.keyCode=83 and window.event.ctrlKey then 
if currentFile<>"" then saveFile 
window.event.cancelBubble = true 
window.event.returnValue = false 
end if 
if window.event.keyCode=66 and window.event.ctrlKey then 
browseMe 
window.event.cancelBubble = true 
window.event.returnValue = false 
end if 
if window.event.keyCode=78 and window.event.ctrlKey then 
createFile 
window.event.cancelBubble = true 
window.event.returnValue = false 
end if 
end sub 
sub browseMe 
dim win 
set win=window.open() 
win.document.write txt.value 
end sub 
sub createFile 
'点创建按钮，真的创建了． 
if vartype(currentSpan)<>0 then currentSpan.style.color = "navy" 
if currentDir ="" then 
'如果点到了文件 
currentDir=getFolderDir(currentFile) 
else 
'点到了文件夹 
dim n 
set n=currentDiv.nextSibling 
do 
if vartype(n) =9 then exit do 
if left(n.title,len(currentDir)) <> currentDir then exit do 
set currentDiv =n 
set n=n.nextSibling 
loop 
end if 
dim re,newFile,s,f 
set re = new RegExp 
re.Pattern = "[^\d]" 
re.Global=true 
newFile = currentDir & "新收藏" & re.Replace(mid(cstr(now()),3),"") & ".txt" 
currentFile=newFile'新建文件是当前文件 
'构造innerHTML 
s = "<div class='file' title='" & newFile 
s = s & "' style='margin-left:" 
if currentDiv.className = "file" then 
s = s & currentDiv.style.marginLeft & ";' > " 
else 
s = s & px2Int(currentDiv.style.marginLeft) + 8 & ";' > " 
end if 
s = s & "<span class='fileIcon'>2" & "</span>" 
s = s & "<input value='" 
s = s & getTxtName(lastOne(newFile,"\")) & "' title='" & getTxtName(lastOne(newFile,"\")) & "' onchange='vbs:reName me' />" 
s = s & "</div>" 
'插入innerHTML 
currentDiv.insertAdjacentHTML "AfterEnd",s 
articleTitle.value = getTxtName(lastOne(newFile,"\")) 
txt.value = "" 
currentDir = "" 
set currentDiv = currentDiv.nextSibling 
set currentSpan = currentDiv.getElementsByTagName("SPAN")(0) 
currentSpan.style.color = "red" 
'创建文件 
set f=fso.CreateTextFile(newFile) 
f.close 
end sub 
function getFolderDir(fullDir) 
'输入得到全路径，得到文件夹路径 
s=LastOne(fullDir,"\") 
getFolderDir = left(fullDir,len(fullDir)-len(s)) 
end function 
sub saveFile 
'保存对文件的修改 
Dim st 
Set st = fso.OpenTextFile(currentFile, 2, True) 
st.Write txt.value 
st.close 
end sub

sub deletFile 
'删除文件 
dim n 
if window.event.keyCode =46 and window.event.srcElement.tagName<>"INPUT" then 
if currentFile<>"" then 
if currentFile = thisFileDir then 
alert "不允许删除本文件！" 
exit sub 
end if 
if fso.FileExists(currentFile) then 
fso.deletefile currentFile,true 
currentDiv.parentElement.removeChild currentDiv 
txt.value = "" 
currentFile = "" 
articleTitle.value = "" 
end if 
end if 
if currentDir<>"" then 
if currentDir = thisFileFolder then 
alert "不允许删除根目录！" 
exit sub 
end if 
set n = currentDiv.nextSibling 
if window.confirm( currentDir & vbcrlf & "这个文件夹有子文件，你要删除全部子文件吗?") then 
do 
if vartype(n) =9 then exit do 
if px2Int(n.style.marginLeft) <= px2Int(currentDiv.style.marginLeft) then exit do 
n.parentElement.removeChild n 
set n=currentDiv.nextSibling 
loop 
if fso.FolderExists(currentDir) then fso.DeleteFolder currentDir 
currentDiv.parentElement.removeChild currentDiv 
end if 
end if 
end if 
end sub 
sub showMe(obj1,obj2) 
obj1.style.display="" 
obj2.style.display="none" 
end sub 
sub beginDrag 
'开始拖拽 
delatX=window.event.clientX - px2Int(hide_control.currentStyle.left) 
document.attachEvent "onmousemove",getRef("moveHandler") 
dragAble = true 
window.event.cancelBubble = true 
end sub 
sub moveHandler 
'移动绑定事件 
if not dragAble then exit sub 
dim x 
x = window.event.clientX - delatX 
hide_control.style.left= x & "px" 
frmTree.style.width = abs( x - 10) & "px" 
frmSeach.style.width = abs( x - 10) & "px" 
txtFrm.style.left=( x + 20) & "px" 
window.event.cancelBubble=true 
end sub 
sub upHandler 
'放开绑定事件 
document.detachEvent "onmousemove",getRef("moveHandler") 
dragAble = false 
window.event.cancelBubble=true 
end sub 
function getTxtName(fullName) 
'去掉文件名后缀 
dim s:s=lastOne(fullName,".") 
getTxtName = left(fullName ,len(fullName)-len(s)-1) 
end function

sub reName(obj) 
'改名 
dim Arr,a 
Arr=array("/","\",":","*","?",chr(34),"|","<",">") 
for each a in Arr 
if instr(obj.value,a) >0 then 
alert "命名不能含有/\:*?" & chr(34) & "|<>其中的一个" 
obj.focus 
exit sub 
end if 
next 
dim oldName,newName,oldPath,oldType 
oldName = obj.parentElement.title 
oldPath = getFolderDir(oldName) 
oldType = lastOne(oldName,".") 
newName = oldPath & obj.value & "." & oldType 
Set f = fso.GetFile(oldName) 
f.copy newName 
f.delete True 
obj.parentElement.title = newName 
articleTitle.value = getTxtName(lastOne(newName,"\")) 
end sub 
Function LastOne(Str,splitStr) 
'输入字符和分隔符，得到最后一部分 
LastOne = right(Str,len(Str)-InStrRev(Str,splitStr)) 
End Function 
sub selectControl 
'控制页面选择的状态 
if window.event.srcElement.tagName<>"INPUT" and window.event.srcElement.tagName<>"TEXTAREA" then 
document.selection.clear 
end if 
end sub 
function isTXT(fileNameStr) 
'判断是否是文本类型的文件 
dim s,Arr,a,returnValue 
returnValue = false 
s=lcase(LastOne(fileNameStr,".")) 
Arr=array("txt","htm","html","asp","csv","aspx","xml","js","vbs","ini","bat","css","htc","hta","xsl","xslt","sql") 
for each a in Arr 
if a=s then 
returnValue =true 
exit for 
end if 
next 
isTXT = returnValue 
end function 
sub showFolder(obj) 
dim folderspec :folderspec = obj.title 
obj.setAttribute "parsed",true 
if not fso.FolderExists(folderspec) then 
alert folderspec & "该文件夹不存在，也许是被移动了，所以刷新一下本程序" 
window.location.reload 
exit sub 
end if 
dim f, f1, sf,sf1,i,s,fName 
set f=fso.GetFolder(folderspec) 
set sf=f.Subfolders 
re = re & f.name & "\" 
s="" 
for each sf1 in sf 
s = s & "<div class='folder' title='" & sf1.path & "\' style='margin-left:" & cint(replace(obj.style.marginLeft,"px","")) + 8 & ";'>" 
s = s & "<span class='folderIcon'>0" & "</span><input value='" & sf1.name & "' readonly style='cursor:hand;'/></div>" 
next 
For Each f1 in f.Files 
if isTXT(f1.name) then 
s = s & "<div class='file' title='" & f1.path 
s = s & "' style='margin-left:" 
s = s & px2Int(obj.style.marginLeft) + 8 & ";' > " 
s = s & "<span class='fileIcon'>2" & "</span>" 
s = s & "<input value='" 
fName = getTxtName(f1.name) 
s = s & fName & "' title='" & fName & "' onchange='vbs:reName me' />" 
s = s & "</div>" 
end if 
Next 
obj.insertAdjacentHTML "AfterEnd",s 
end sub 
function px2Int(px) 
px2Int = cint(replace(px,"px","")) 
end function 
sub f_Click() 
dim obj,d,f,state 
set obj = window.event.srcElement 
if obj.id="searchKey" then exit sub 
if obj.tagName<>"SPAN" and obj.tagName<>"INPUT" then exit sub 
set currentDiv = obj.parentElement 
set obj = currentDiv.getElementsByTagName("SPAN")(0) 
window.event.cancelBubble = true 
select case obj.className 
case "folderIcon" 
'点到了文件夹 
if vartype(currentSpan)=8 then 
currentSpan.style.color = "navy" 
end if 
set currentSpan = obj 
state = abs(cint(obj.innerHTML) -1) 
obj.innerHTML = state 
obj.style.color="red" 
set d = obj.parentElement 
currentDir = d.title 
currentFile = "" 
if d.getAttribute("parsed")=true then 
'合拢 
fold d,state 
else 
'解析 
showFolder d 
end if

case "fileIcon" 
'点到了文件,在textArea里面载入文本文件 
if vartype(currentSpan)=8 then 
currentSpan.style.color = "navy" 
end if 
set currentSpan = obj 
obj.style.color="red" 
readText obj.parentElement.title 
currentDir = "" 
currentFile = obj.parentElement.title 
end select 
end sub 
sub fold(o,stateOpen) '合拢 
dim n 
set n=o.nextSibling 
do 
if vartype(n) =9 then exit do 
if px2Int(n.style.marginLeft) <= px2Int(o.style.marginLeft) then exit do 
if stateOpen=1 then n.style.display="" else n.style.display="none" 
set n=n.nextSibling 
loop 
end sub

sub readText(filePath) 
Dim f,fName 
if not fso.FileExists(filePath) then 
alert filePath & vbcrlf & "该文件不存在，也许是被移动了，所以刷新一下本程序" 
window.location.reload 
exit sub 
end if 
'TXT已经加载的当前文件不再加载. 
if filePath = currentFile then exit sub 
txt.value = "" 
Set f = fso.OpenTextFile(filePath, 1, true) 
if not f.AtEndOfStream then 
txt.value = f.readAll 
else 
txt.value = "" 
end if 
fName = lastOne(filePath,"\") 
articleTitle.value = getTxtName(fName) 
f.Close 
Ln.innerText = 1 
End sub 
sub TabTxt() 
'支持tab键的文本框 
if window.event.keyCode=38 then 
if cint(Ln.innerText) >1 then Ln.innerText = cint(Ln.innerText)-1 
end if 
if window.event.keyCode=40 then 
Ln.innerText = cint(Ln.innerText)+1 
end if 
if window.event.keyCode<> 9 then exit sub 
dim sel,mytext 
set sel = document.selection.createRange() 
'txt.createTextRange 
mytext = sel.text 
if len(mytext)=0 then 
sel.text =string(4," ") 
window.event.cancelBubble = true 
window.event.returnValue = false 
exit sub 
end if 
dim t,Arr 
t=0 
Arr = split(mytext,vbcrlf) 
if window.event.shiftKey then 
'按sift 
for i=0 to ubound(Arr) 
if left(Arr(i),1)=vbtab then 
Arr(i) = mid(Arr(i),2) 
t= t + 1 
else 
for j=1 to 4 
if left(Arr(i),1)=" " then 
Arr(i) = mid(Arr(i),2) 
t= t + 1 
else 
exit for 
end if 
next 
end if 
next 
t= t 
else 
'不按sift 
for i=0 to ubound(Arr) 
Arr(i) = vbtab & Arr(i) 
t= t +1 
next 
end if 
mytext = join(Arr,vbcrlf) 
sel.text = mytext 
sel.collapse true 
sel.moveEnd "character",0 
sel.moveStart "character",(len(mytext) * -1) + t 
sel.select() 
window.event.cancelBubble = true 
window.event.returnValue = false 
end sub 
'下面是关于搜索 
dim seachResult'查找结果 
dim num '结果数量 
dim word'搜索关键字 
tagStop = false 
seachResult ="" 
sub seachFile() 
num =0 
seachList.innerText = "搜索结果" 
word = searchKey.value 
seachResult ="" 
if trim(word)="" then 
alert "关键字为空！" 
searchKey.focus 
exit sub 
else 
dim l 
for each l in list.getElementsByTagName("DIV") 
if l.id<>"seachList" then list.removeChild l 
next 
seachList.innerText = "搜索结果" 
seachWord thisFileFolder 
seachList.insertAdjacentHTML "AfterEnd",seachResult 
seachList.innerText = "搜索结果：" & num & "个" 
alert "搜索完毕！" 
end if 
end sub 
sub seachWord(theFolder) 
dim f,f1,st,re,fd,fd1 
set f = fso.GetFolder(theFolder) 
for each f1 in f.Files 
if isTxt(f1.name) then 
if instr(f1.name,word)>0 then 
seachResult = seachResult & "<div class='file' title='" & f1.path 
seachResult = seachResult & "'><span class='fileIcon'>2" & "</span>" 
seachResult = seachResult & "<input value='" 
fName = getTxtName(f1.name) 
seachResult = seachResult & fName & "' title='" & fName & "'>" 
seachResult = seachResult & "</div>" 
num = num + 1 
else 
set st = f1.OpenAsTextStream 
'逐行读 
Do While st.AtEndOfStream <> True 
if instr(st.ReadLine,word)>0 then 
num = num +1 
seachResult = seachResult & "<div class='file' title='" & f1.path 
seachResult = seachResult & "'><span class='fileIcon'>2" & "</span>" 
seachResult = seachResult & "<input value='" 
fName = getTxtName(f1.name) 
seachResult = seachResult & fName & "' title='" & fName & "'>" 
seachResult = seachResult & "</div>" 
exit do 
end if 
Loop 
st.Close 
end if 
end if 
next 
set fd = fso.GetFolder(theFolder) 
for each fd1 in fd.SubFolders 
seachWord fd1 
next 
end sub

sub showHelp 
dim msg 
msg = " 文本代码管理工具【IE5.5以上版本】" & vbcrlf 
msg = msg & "------------------------------------------------" & vbcrlf 
msg = msg & " 使用方法：放到文本类型的文件夹里面，双击运行。" & vbcrlf 
msg = msg & "功能：" & vbcrlf 
msg = msg & "1，快速浏览,预览CTRL+B，搜索文本类型的文件和代码；" & vbcrlf 
msg = msg & "2，按DEL可以删除点中的文件和文件夹；" & vbcrlf 
msg = msg & "3，可以修改文件名和文字内容,CTRL+S保存；" & vbcrlf 
msg = msg & "4，可以创建文件CTRL+N并且编辑保存；" & vbcrlf 
msg = msg & "5，文本编辑支持TAB和shift+TAB键；" & vbcrlf 
msg = msg & vbcrlf 
msg = msg & "作者：CSDN超级大笨狼[2005/1/18版本]" & vbcrlf 
msg = msg & "欢迎传播使用,交流代码panyuguang962@sohu.com" & vbcrlf 
msg = msg & "http://superdullwolf.cnzone.net/index.asp" & vbcrlf 
alert msg 
end sub 
</SCRIPT> 
</BODY> 
</HTML>