FSO的强大功能_ASP教程-查字典教程网

FSO的强大功能

摘要：笨狼代码大管家body{font-size:12;BACKGROUND:#DADADA;margin-left:5;}.folder{fon...

<HTML>

<HEAD>

<TITLE>笨狼代码大管家</TITLE>

<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>

<hr/>

</div>

<hr/>

</div>

标题：<input id="articleTitle" style="width:100" readonly/>

行<span id="Ln">1</span>

</div>

'**************************

'*****超级大笨狼***********

'**************************

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

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 title='" & newFile

s = s & "' >"

else

s = s & px2Int(currentDiv.style.marginLeft) + 8 & ";' >"

end if

s = s & "<span>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

if currentDir<>"" then

if currentDir = thisFileFolder then

alert "不允许删除根目录！"

exit sub

end if

set n = currentDiv.nextSibling

if window.confirm( currentDir & vbcrlf & "这个文件夹有子文件，你要删除全部子文件吗?") then

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 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

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

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 title='" & sf1.path & "'>"

s = s & "<span>0" & "</span><input value='" & sf1.name & "' readonly/></div>"

For Each f1 in f.Files

if isTXT(f1.name) then

s = s & "<div title='" & f1.path

s = s & "' >"

s = s & "<span>2" & "</span>"

s = s & "<input value='"

fName = getTxtName(f1.name)

s = s & fName & "' title='" & fName & "' onchange='vbs:reName me' />"

s = s & "</div>"

end if

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

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

t= t

else

'不按sift

for i=0 to ubound(Arr)

Arr(i) = vbtab & Arr(i)

t= t +1

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

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 title='" & f1.path

seachResult = seachResult & "'><span>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 title='" & f1.path

seachResult = seachResult & "'><span>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

set fd = fso.GetFolder(theFolder)

for each fd1 in fd.SubFolders

seachWord fd1

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>

【FSO的强大功能】相关文章：

★ 防范ASP木马的十大基本原则强列建议看下

★ 百度小偷

上一篇：写入文本文件的过程函数(ASP)

下一篇： FSO 读出TXT文件

学习工具