FSO的强大功能
2018-09-06 10:29
<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
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 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
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 & "欢迎传播使用,交流代码quot; & vbcrlf
msg = msg & "
alert msg
end sub
</SCRIPT>
</BODY>
</HTML>
下一篇：ASP让url的中文显示为编码