FSO的强大功能
技术 / 管理员 发布于 7年前 396
复制代码 代码如下:
<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 & "欢迎传播使用,交流代码[email protected]" & vbcrlf
msg = msg & "http://superdullwolf.cnzone.net/index.asp" & vbcrlf
alert msg
end sub
</SCRIPT>
</BODY>
</HTML>
<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 & "欢迎传播使用,交流代码[email protected]" & vbcrlf
msg = msg & "http://superdullwolf.cnzone.net/index.asp" & vbcrlf
alert msg
end sub
</SCRIPT>
</BODY>
</HTML>
上一条：
Lua文件读写详解
下一条：
PJBLOG使用技巧
- 近期文章
- 智能合约Solidity学习CryptoZombie第三课:组建僵尸军队(高级Solidity理论)(0个评论)
- 智能合约Solidity学习CryptoZombie第二课:让你的僵尸猎食(0个评论)
- 智能合约Solidity学习CryptoZombie第一课:生成一只你的僵尸(0个评论)
- 在go中实现一个常用的先进先出的缓存淘汰算法示例代码(0个评论)
- 在go+gin中使用"github.com/skip2/go-qrcode"实现url转二维码功能(0个评论)
- 在go语言中使用api.geonames.org接口实现根据国际邮政编码获取地址信息功能(1个评论)
- 在go语言中使用github.com/signintech/gopdf实现生成pdf分页文件功能(0个评论)
- gmail发邮件报错:534 5.7.9 Application-specific password required...解决方案(0个评论)
- 欧盟关于强迫劳动的规定的官方举报渠道及官方举报网站(0个评论)
- 在go语言中使用github.com/signintech/gopdf实现生成pdf文件功能(0个评论)
- 近期评论
-
122 在
学历：一种延缓就业设计，生活需求下的权衡之选中评论 工作几年后，报名考研了，到现在还没认真学习备考，迷茫中。作为一名北漂互联网打工人.. -
123 在
Clash for Windows作者删库跑路了，github已404中评论 按理说只要你在国内，所有的流量进出都在监控范围内，不管你怎么隐藏也没用，想搞你分.. -
原梓番博客 在
在Laravel框架中使用模型Model分表最简单的方法中评论 好久好久都没看友情链接申请了，今天刚看，已经添加。.. -
博主 在
佛跳墙vpn软件不会用?上不了网?佛跳墙vpn常见问题以及解决办法中评论 @1111老铁这个不行了，可以看看近期评论的其他文章.. -
1111 在
佛跳墙vpn软件不会用?上不了网?佛跳墙vpn常见问题以及解决办法中评论 网站不能打开，博主百忙中能否发个APP下载链接，佛跳墙或极光..
Copyright·© 2019 侯体宗版权所有·
粤ICP备20027696号
