圆月山庄资源网 Design By www.vgjia.com
复制代码 代码如下:
<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> 
标签:
FSO的强大功能

圆月山庄资源网 Design By www.vgjia.com
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件! 如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
圆月山庄资源网 Design By www.vgjia.com

稳了!魔兽国服回归的3条重磅消息!官宣时间再确认!

昨天有一位朋友在大神群里分享,自己亚服账号被封号之后居然弹出了国服的封号信息对话框。

这里面让他访问的是一个国服的战网网址,com.cn和后面的zh都非常明白地表明这就是国服战网。

而他在复制这个网址并且进行登录之后,确实是网易的网址,也就是我们熟悉的停服之后国服发布的暴雪游戏产品运营到期开放退款的说明。这是一件比较奇怪的事情,因为以前都没有出现这样的情况,现在突然提示跳转到国服战网的网址,是不是说明了简体中文客户端已经开始进行更新了呢?