FSO的强大功能

更新时间：2007年02月10日 00:00:00 作者：
<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> 