FSO的强大功能
程序员文章站
2023-12-05 22:53:22
复制代码 代码如下: 笨狼代码大管家 &nbs...
复制代码 代码如下:
<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>