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 & "欢迎传播使用,交流代码[email protected]" & vbcrlf msg = msg & "http://superdullwolf.cnzone.net/index.asp" & vbcrlf alert msg end sub </SCRIPT> </BODY> </HTML>