<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>
易网时代-编程资源站