文本代码管理工具(笨狼代码大管家) - 中国DOS联盟论坛

今天在网上无意逛到的，识货的另存为文本代码管理工具.hta其中很多VBS代码值得学习，作者都标注说明了

<HTML>
<HEAD>
<TITLE>笨狼代码大管家</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style>
body 
{
	font-size:12;
	BACKGROUND: #DADADA;
	margin-left:5;
	overflow:visible;
}
 
.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;
	font-size:12px;
	overflow-x:visible;
	overflow-y:scroll;
                margin-left:40;             
}

#frmTree
{ 
	WIDTH:200px;
	height:630;
	MARGIN: 0px;
	PADDING: 0px;	
	overflow:scroll;
	overflow-x: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:43px;
	WIDTH:10px;
	height:630;	
	BACKGROUND: #DADADA;
	padding-top:300;
	cursor:e-resize;
	border:1 solid gray;
	z-index:100;
}
#frmTop
{
	width:100%;
	height:20;
}		
#txtFrm
{ 
	POSITION: absolute;
	LEFT:230px;
	TOP:50px;
	WIDTH:100%;
	MARGIN-left: -20px;
	PADDING: 0px;
	BACKGROUND: #DADADA;
 } 
#txtRead
{
	display:none;
	position:absolute;
	color:red;
	font-size:18 px;
	top:0;
	left:0;
	background-color:black;
	z-index:1000;
}
 
 #tab1
 {
	border:1 solid  ;
	cursor:hand;
 }
  #tab2
 {
	border:1 solid  ;
	cursor:hand;
	BACKGROUND: gray;
	margin-right:200;
 }

</style>
 
 
</HEAD>
<BODY onselectstart="vbs:selectControl" onkeydown="vbs:shortCut">

<div id="frmTop">
	<span id="tab1" onclick="vbs:showMe me"> &nbsp;目 录 </span>
	<span id="tab2" onclick="vbs:showMe me" > &nbsp;搜 索 </span>
		标题：<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="format" onclick="vbs:formatXML">格式化XML</button>	
	<button id="test" onclick="vbs:read">阅读模式</button>	
	<button id="test" onclick="vbs:showHelp">说明</button>	
	行&nbsp;<span id="Ln">1</span><hr/>
</div>
<div  id="frmTree" onclick="vbs:f_Click" onkeydown="vbs:deletFile" >

	<div id="tree" style='margin-left:0;color:navy;font-size:12;cursor:hand;' ></div>
</div>
 
<div  id="frmSeach" onclick="vbs:f_Click" >

	<hr/>
	<div id="list" style='margin-left:0' onkeydown="deletFile">
	<input id="searchKey" style="width:100" onkeypress="vbs:searchPress"/>	
	<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">

	<textarea id="txt"   onkeydown='vbs:TabTxt' onclick="vbs:showLn"  ></textarea>	
</div>
<div valign="top" id="txtRead" >

	
	<button  onclick='vbs:closeRead' >关闭</button>
	<br/>
	 <iframe id='ifrm' frameborder=0 width="101%"  height="1000" SCROLLING="no" ></iframe> 
</div>

 
 
<SCRIPT LANGUAGE="vbscript">


'**************************
'*****超级大笨狼***********
'**************************
	on error resume next
	window.resizeTo window.screen.availWidth,window.screen.availHeight
	window.moveTo 0,0
	frmTree.style.height = cint(window.screen.availHeight )-70
	hide_control.style.height = cint(window.screen.availHeight * 0.98)+5
	txt.style.height = cint(window.screen.availHeight )-70
	txt.style.width = cint(window.screen.availWidth - 250) 
	'txt.style.width = window.screen.availWidth - px2Int(txtFrm.style.left) -20
	
	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	
	dim Dtitle
	
	Dtitle=document.title

	currentDir = thisFileFolder		
	set currentDiv = tree
	tree.innerText =  getTxtName(thisFileName)	
	
	showMe tab1
	showFolder tree 
	
sub read
	txtRead.style.display="block" 
	txtRead.style.border="1px solid red"	 
	 
	   
	 HTML="<marquee id= SCROLLAMOUNT='4' SCROLLDELAY='1'  direction='up' height=' " & window.screen.availHeight-80  & "'>" 
 	 HTML=  HTML & "<xmp style='word-wrap:break-word;line-height:60px ;' >" &  txt.value & "</xmp></marquee>"  
	ifrm.document.body.innerHTML= HTML 
	ifrm.document.body.style.backgroundColor = "#000000"
	ifrm.document.body.style.fontSize="40"	 
	ifrm.document.body.style.color="red"
	ifrm.document.body.style.textDecoration="underline"
	set marquee=ifrm.document.body.getElementsByTagName("marquee")(0)
	marquee.onmousemove=getRef("setMarquee")
end sub
 
 
 

sub setMarquee
	set m=ifrm.document.body.getElementsByTagName("marquee")(0)
	pos=  ifrm.window.event.clientY 
	total=  ifrm.window.screen.availHeight 		 
	if not isnumeric(pos) then exit sub
	if pos >total*2/5  and pos< total*3/5 then 
		m.stop  
		 
	else 
		m.start		 
	end if
	if  pos< total*2/5 then 	
		m.direction="down"   
	else 
		m.direction="up" 	 
	end if

	if  pos >total/5  and pos< total*4/5 then
		m.scrollAmount=1
	else
		m.scrollAmount=int(abs((pos-total/2)/20-8))
	end if
	 
end sub

sub closeRead
	 txtRead.style.display="none" 
	 
end sub

sub showLn
	Ln.innerText = cint((window.event.offsetY-2)/15)+1	
	
end sub

sub txt_onscroll
	frmTop.scrollIntoView
end sub	

sub formatXML()	 
	set doc = createobject("MSXML2.DOMDocument") 
	if doc.loadXML(txt.value) then
		Dim rdr, wrt
		set wrt = createobject("MSXML2.MXXMLWriter")
		set rdr = createobject("MSXML2.SAXXMLReader") 		
		wrt.indent = True
		Set rdr.contentHandler = wrt		
		rdr.parse(txt.value)
		txt.value = wrt.output
	else
		alert("XML格式不正确，请确保Well-Formed！")
	end if	 
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(currentFile)
	'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 = ""
	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 & ";' >&nbsp;"
	else
		s = s  &  px2Int(currentDiv.style.marginLeft) + 8 & ";' >&nbsp;"
	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  f, st 
   set f= fso.GetFile(currentFile)  
   If f.attributes and 1 Then
		if	window.confirm("该文件属性为只读,是否改变其属性并保存修改？") then f.attributes = f.attributes - 1
	end if
   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 left(currentDir,len(currentDir)-1)
						currentDiv.parentElement.removeChild currentDiv														
					end if
		end if
		
	end if	
end sub



sub showMe(obj)
	if obj.id ="tab1" then
		tab2.style.backgroundColor="gray"
		tab1.style.backgroundColor="#DADADA"
		frmSeach.style.display="none"  
		frmTree.style.display=""
	else
		tab1.style.backgroundColor="gray"
		tab2.style.backgroundColor="#DADADA"
		frmSeach.style.display=""
		frmTree.style.display="none"  
	end if

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"
	txtFrm.style.left=( x + 20) & "px"	
	txt.style.width = window.screen.availWidth - px2Int(txtFrm.style.left) -20
	window.event.cancelBubble=true
end sub

sub upHandler
'放开绑定事件	
	document.detachEvent "onmousemove",getRef("moveHandler") 
	dim x
	x = window.event.clientX - delatX
	
	if px2Int(hide_control.style.left)>205 then
	 frmTree.style.width = abs( px2Int(hide_control.style.left)-10) & "px"	
	 frmSeach.style.width = abs( px2Int(hide_control.style.left)-10) & "px"
	 else
	 frmTree.style.width = "200px"	
	 frmSeach.style.width = "200px"
	end if

	

	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
                currentFile = 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","sql","htm","html","asp","csv","aspx","xml","js","vbs","ini","bat","css","htc","hta","xsl","xslt","lrc","vb","cs","cx","asa","aspx","asax","config","shtml","stm","cpp","c","cxx","h","hpp","rc","pl","pm","cgi","php3","php","java","jsp","tpl","wsh","sgf","xsd","udl","asmx","inc","cmd")
	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 & ";' >&nbsp;"
				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 searchPress
	if window.event.keyCode=13  then
		seachFile
	end if
end sub

'显示搜索结果
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.path)  then
			if instr(f1.path,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,f,re,version
	set f=fso.GetFile(thisFileDir)
	version = f.DateLastModified 
	set re = new RegExp	
	re.Pattern = ""
	re.Global=true
	version =  re.Replace(mid(cstr(version),3),"/") 
                version =   left(version ,len(version)-3)
	set re = nothing	
	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 & "6，格式化Well-Formed的XML文件；"	& vbcrlf
	msg = msg &    vbcrlf
	msg = msg & "作者：CSDN超级大笨狼请随时到网站检查最新版本" & vbcrlf	
	msg = msg & "欢迎传播使用,交流代码panyuguang962@hotmail.com" & vbcrlf
	msg = msg & "http://superdullwolf.cnzone.net/index.asp" & vbcrlf
	alert msg
end sub
</SCRIPT>
 
</BODY>
</HTML>

[ Last edited by fastslz on 2007-12-17 at 10:51 PM ]

这个是早期的另外一个版本

@echo bs=_>xx.vbs
@echo "SFmchoxBA8MkzBAANAAAAAAAAAwcfRHICyEAvJBAAQeQAAgA0ldfS3MtReTH1wCAgAAAA4Mxx6Lt6L865yNwtnLp++tLoRXYAUmaHyyZj7UA4pao7ZAdl31dRBgLoRXYniBPOMdzI7SvF3Kpe/WP2x3PSMF0hoeagknY2Nq6I6ls"+_>>xx.vbs
@echo "ogF2UXlvo7gJhu1mjFig5ks9hfQzfIDZ76k4WqHS/bMhCjVxBbEq0JGpdGOJtsY+qKJoZ1dQ3ShHnc30EpE9l4LEJ2LLL5NXNMNYnDOFQlXoZ44LcFHHncudQSyezKF13RTVLNRr2CHuxaJ6cRQg3ycvV7jdsocZjxn89bdn6NRJ"+_>>xx.vbs
@echo "/U22M1yhLroV8oPNhW/++EvaGUtJvsfvRHrQTmSTIVrTueSrt6tjbKtotx0B1KmF4IAqZxtxlYbeQz6gn5achULM8b6RnfaMR04mT7rzdrtBfTi1c0OlNgTjPMXPgZESXALTBB/krhrdVhyj+Mjs3w/2hTqcfXYGnK+BrPIcxwIo"+_>>xx.vbs
@echo "BOXe060AKtMV24SdVVAUw0+YY97ct4AEz0fEu/s2XpNarT65xD1KZjcxiApbGXyVAinBTHGXjqmHEeG/YO6LnMSx7yobmsOxj77pTO34nOBHeNQbmah6i1fnYn/MNUTQtfOznJqIbAl8VvTsAyGk/CYi52FypznDKaRRB69QIdEP"+_>>xx.vbs
@echo "p/LKGGO2W2geOJm+yrbpa/1HDdkjyxdAHtHWRhbn9O9kCzVFw02K8o7D+yUgcT3TROq3cYFFlgyS52Zs5d6eE8bdGD5OslYg6xZWUcOtF2pYwPECeV7NZbkwet5o/4fCeNmp6FYXQSAvUaMbopC/c3+cZLFuoSBeGG9U+NvfNvny"+_>>xx.vbs
@echo "z758KUXm2tX5dUvU5e+DQr+SPl3ql01zuM4yo1vLYmZLSsQYFWUWtCc4Q0TmYLiSvUZ68ctOEyItqtxAHycxokWDSM6rJyN2Dm7vFoX8UiJ1fD9Amj1IggXfv6w9Z7pTQb+gKcYxloYJbE8sMtHmPVnwPFHS2yJ/kvg+X3/gcDNA"+_>>xx.vbs
@echo "iXybf/aDuZBryllOYsP0cmDBFf1SiLSTNvFvXHZpvJQIruU3oxUEHiI9haiRSVNGcIbrB2QxbSZkibkbBqWwZYS0EE8nIyl1YPdka71ZjTCe9HQDELrdKJwu+pKvfhOAYzY+wCVL11lRN6BeVhCSeSSvXrj9cDmABu56k5PALVvi"+_>>xx.vbs
@echo "B/QjmLZyzYE82o2dW7IaSAIsJCEexyWTAhHsIn2SYlDORLuVoQUnkrT6tuVTPC90NCGSeLGikHDia/dHyBPEdIJdGxmoquXLO7eJS1GiYWdegd4DHFMC7MoASb19vFT4BX9XH/XYCs2pgNwJZf2KerbE6tqWvRRgBbIk+2ae30wn"+_>>xx.vbs
@echo "eGi+jZ6/JuCHsjgo/xOuxs1LnlUQYjogi+7txb/b4Okanr422YcrO9h/mkW+1/v7Q3Ywc526zjpbLlIYRVwB1l89ZHsXLhCNhV0i6S8pXQW038OdELqfmM2eypQyfX3iVXut3sKFnvqLf/sIAKX3yHvwNdXSPoUBmGMWwnkjM7hi"+_>>xx.vbs
@echo "5yAIZkD0vNcgmcSL+hBc+lMW8f0EhtVe7edIeWPevl/Lp5mX7ixzivsljFSdgEIUs/zi1KSxe/7hk2U/Xb0uYIB+S3ntIz2H1HnHNL0rRHbJVgvgC51kEvP5z64lktfKlqS5TIslS9n6SUjGQKIriIXZIqs6cC9Tl0vpGF1vb+aE"+_>>xx.vbs
@echo "c/em52FdQEjgAIVTBZwSF4xJ0G7Hc9/TRd0ByNg636j8e10M0SofT2FtHNxHSvRk9aqw9LpdYZeF7G6pbgOQksJkz3SCOUb3Ft4sJ7bu31tizEaftwwug9EoNS1fL3tSnMoiWBKdLl4BkwU1qDicaumgPXTVPAxGGwiuuCa9LNAi"+_>>xx.vbs
@echo "VnCPg2LXVGQtl1BjOyVlHc5yYT7IBrqIuwS+RlJlOcHhMxX3LIemdwHadAJvPkXjhaiO2bp/oJto8PWBcT/gl/sVj9R5HHXG4oqD1HN2vwTkGVeLtx5pQQ28hCuPpwoUOCzAvdYfi+Zssv9s1IRcHFDd0um/5aIBXACZiOI0zE2B"+_>>xx.vbs
@echo "Q7wXgGOAF/ktYl3EnLW/ugjfHM4k811qHIo+VJ72nj67gHAjdFL41fGVVmBzTsXOx0NcI1+v+Y2WWX/4IrMgTJn0AM+BI9Z3W4lc107ntd4TZtSdu9HfgblFD6qdT+dXyZC7+v0npk2cCUvU1bb/4w+/WKX4banJtI7FtqmexbeV"+_>>xx.vbs
@echo "Wej4z8OvaFZ4mUveenhrSFVtVp72yrQpSD2azlBJfTAt6wrPSDecxf/0UDgmRohEAJNyCFklZ19EI+ENJQI8XoQ8fICCaPOAD+xYzafZ8F/GNX4+sSiyAuCORGlDYfPl9AfiOdWfrS/W8QmsQpvVw3BLyu1clLIBZefayyFX9T5z"+_>>xx.vbs
@echo "NNMEcNbcXt+0dLMupJjJoUKK+upOHpagxaa0XtLk0Q1KDAkAGO+MErRQ34V3zBO56l9XUYN3YlzKL6TLLXNMDrq6yJf+v+bUWDuBqgisYx+3W+dZ9KnF8Om1oKyN6DERINfFyN15xUkVYvPlAMDihp70D/TjVxvJd76TbCJj2Lz+"+_>>xx.vbs
@echo "G0KdLmMsKiIKj9ChGYAkkd7L6uGzb7V1zZljC/dKu+8Uj/N3KxQtOTYfTh3lMeIazatXO7QtWfyATV2egy+fqIS845PjYSV9Sud4uVx99fgcgCIFESmSt7S6gvFe7wEjx4dcw3PfFfjbevlycbqZQtU0qrTWuMoCtcaBTNxYf9kj"+_>>xx.vbs
@echo "XIa+khHTJruaJ53kU+5UNYmnVYArMzAuKeMa0RC2cWCa1Pz1kTYF4BNBtTa6InxIonZCmWwxq0qEjflhwQovylsn/iKLoa/85vKqwrYgM7am4hPn1DC76fEWrs+/zDZRB8WP7P0BsStfSaTzMNjp8iceoChjL28Km6UDt/2gPoG2"+_>>xx.vbs
@echo "Jcf6wnoXgGJjmzyXVrFQ9RV8pNSSXn1dJeyPO0OKat7ovbvMgCcAzb3geZB7DlYxWRZcv310lRT0bOLq0RMBhv049STJss/2iDsWmBpS6nHfrHQ9hO6DmsQcKS9LmZ0cEUUBSg4CRPQWFTUCSQEjvbpg+u/kXkTbkJOOHtBBpPbA"+_>>xx.vbs
@echo "F0lAEtMFkjCayEyCAIGzBf0oj701uTKt+1gWFbW/coHECvcVlcPXxroCoLmf2PFBcunk/2nHD1ni4za4CIBCsWAOp9O52wxnM+suF8yztI/s1LC6hoevoB9cT9xMP/LUuU1TdiXbUJjORNjHjii/PpuEbiQ4ZKb3d6Ai+8faQ2Th"+_>>xx.vbs
@echo "YR3PyRH3cFfeMD9OFMBEWPZRKJmLI7MUJKdJPFr2H2RIfcdXgvdiGFXfdzrfyxSG4dmqlosi69+nSFd8lX2N1p0BZC2FJusdizkS72c41GyMHUeaoldlYs0NLHk/V3M/dsUgYyVbFGblGDdsxn5385hMvljGUHWBUsjrSrCTZPcK"+_>>xx.vbs
@echo "KNVG+MJ3aD7NaneO+6AQZrfALz/9UfXbttm7I7c/lmfFn4bGVeuCuI8Oz1Krpcj70WVQCiE8CXoWDeDDo6gAgz+MavLhXXubRxmuV1T58fFS67VMXvfC3CaU+pJuouHDwYX6zTSW8lsup/uZcXKKIh+GX44r71+beN1/AxPmmeEr"+_>>xx.vbs
@echo "6oIL4DA5bn1+M01BxJYgDsWRvzehzrb0/ds/g8QAP1SXmT88t7K2JyuWcAwNAUIMSWIzqQ+r7dTO/g8+mZC3lJr3wQIwAHB5e5Pc2KHNhmqZGSl/1p9yi2tuXDasY/VeDTp4AZqDvZp7XNkhhI4XguGhqBbycbGiZjcdlPKsIzaS"+_>>xx.vbs
@echo "ghzICvdoHxLAbI9ukuNhc/G4SpKcDqqv1OsbFD6obIrfHOW76oCyTiTbHUnVrEpC/RhuW7hdMR4u2NTS2bws3QMz5WpIEXiobj1u1eNX0GhHNvwDpKgd1QlFA0oDPw8SgTuANJ2ZbslFCtykTDmBjKqZXxJrDw/FOvy1OrNDscK6"+_>>xx.vbs
@echo "habIv0Y2YDSQ2SH7/8/WSc2dpZSkv63fZqQ7suNuuTDPK9kIr7mZvgqasWdWxfITPl+9e/gi8MFWD/KKjOdbmzpeIRlenI6A7hzDvqQhTtOOaQDGvHjTRzbPmQkH5JtU1j+VbkEFmQUltv2CMNqgRTIWCoorNnMxr3+nJNNXAJfN"+_>>xx.vbs
@echo "30WMky9/hAKVyAWbvy7xpOq3W+pqN+xwLJwNZFtWVUfg6Gg+w7WD9P95BV8dLvwyvzAb8mL8Xca5XJ5hwkahB6KNuA4ULB3RtRmaXVWolqRR9rChHhpct+owbkHDOv6EZAMo5244WUVEbJ65dSkGCSlS0N0QO7ecMfqPcKOXlxyP"+_>>xx.vbs
@echo "ZoYV5kCWJTok84R1kJUzUzhkYv8pPLl6SgrGEzXO1G3Mu2Cvvoht5Pcv86IYQulK3u7OncXZoK2IuXObRALdUsU5OkU5/gr7dbdUx294cYsD2Q2My4AjokMXJv5iUG4UAkoU2mdLiNFNwijwdNS3iUhbDSM1DImDKWbixmIQ5QiS"+_>>xx.vbs
@echo "5GND9yONEIo7m/GRA94JdouXB6QRwUstvIM3cvNK17N8qKknoxricS1Y0RtVphRO86KwyeZZ8XSllMu+fgvCD6/+LtqdthqUw+Jhb7U+wSTqayT6COJfqh4BvvnGxwID8ZSzQFa8IwdH+aMDtDta5T8zGjCcgyvs+Tu9LJKjxJ27"+_>>xx.vbs
@echo "CRcn/jfmv+PJpDY1K/OWc82HvSIFzxfo3toa6gtfjP78cvhRm2TnHLtGLX1h6DUDTG5clDYVR+24QWgOSiUsPmSLhZlOYr8KJ5tmOMh/ZqbOaMTbjOs+0swm6ZJaQsV7h5IXVqkarRLxTfmqzlR9Bv6bs3r4fOICusA17ztedo5k"+_>>xx.vbs
@echo "h7mzUER/jIvQp9hy58/+8w+5qvoxKmP244Ao8IiS/NjgfTml2BvYtxntV2NoGtMh16gDYtz85Ef7gm22DBClgdTvJh1NyHpbgaka59VskHGcAXHZq+ci1z2lE5lUKxeIvcL5Qh0GW4fV0Oz0LwvH2UIRFszuf/o6fK1sp7BrPsrT"+_>>xx.vbs
@echo "FdVT29y410yTXqegyEj+MA/LlAkC7nrQ/1DD+7hOHSYagG7zzuvSpGO036po9GF0Q4wGA/5vYUdEOXX15MELe4ltstAIyeAGZ0lkn7xrv2c4i1PxKlmvOgrsqxws10BpyGYHaEaQpf+4LLNzfWd/kwVX0A+nQOic7MJJb84NPpZv"+_>>xx.vbs
@echo "t6T3wqwuKATk1XZ/fDHfWidS3uD2+frRqmE2iPkoUt7is0tXoo8Z15e6ltZEVP86PF4OW+5nUTb60RNI/Wewj4o/ppa2hrQEP7wvcJzJ5VMMOkBU7GeVUuN4Xiq3JQAf86m2pOJ53byDPurhmWQ53Xzoo5AK+lazQMO+A79K/xYI"+_>>xx.vbs
@echo "8pjLTkBwTsVw1WnlXJvtncFT3KSuzp2/L/lODrMpOPRry299YXw/m/Iux8o4c0Dlz5CwVszT3HtEADzlTr+QNjskbOjhfn2Oz+1bElqxHkjLLDcxmg0pnk3g01R+cmzyL2H5gAo8oye009B6pHGo+hil5XLYitQwxXvWt+l9xqEk"+_>>xx.vbs
@echo "MvbKQvtyEQBnVT2u/4Y3525pwgH/NYu8Q9eUhBNm8ADyLlB1g0eh/gaJbo9KGT03hqVILFWxJv33d2HMzXZ/0G9GTUucg3Ml92Gihwqr1uZtE1N6rEFZ9p8N6ff4lODVfvvGrzuTHU/uT6eAjkmul5HKBeiDT/1s4MJMUrDZaKnO"+_>>xx.vbs
@echo "edqkR8MU4+pB0xyv32Ytoy9sA4a1y/O2NsEHBQuVyAJtbM0rsnAVartaSpwvbLvuJmvFOQoX7kiDKp60RfDCggkOITyvtbZv/EU07qqY94QqILaidXrpwdTBbKUJnjGp67ezft+5MxEH5g0dDG4jJUCcidjaG4sYRL4j2+2wwe04"+_>>xx.vbs
@echo "alysaMJq+P6ycSLFOtf8lILLE5RHYAHCjBGMfhUFCsURKl0vQ6JU9gmmgjcpAEawjl9ALQhobI/NPz/SRwEm+4lnOohfSPu0/+uHeeAi62WjlvnFquEe88u7bsUGwuXOwuDYSoYxyoJ5TE6kmr6sJ6N4CV2TLL1ZZhPtovPDH6LE"+_>>xx.vbs
@echo "L2NJs5JgFKZgmPwo18HlvLSQQpnYiuBVVwqfjDMjBLFrpr/rXfy/t8CDwQgHrzbjDsLyah78OGz70tiKEXSdd7jFsiYyDptcpxUMlQp0KR6J2I6kSB1qNFC305owgxJXrWkmU/ZRhntGN3hbZUBGPbYaNNLEsXCJM7sMs18lbUJT"+_>>xx.vbs
@echo "Al6mye6+WWb+bqDqUxy9pOC6caDduKRkkdhAWSmeTeLiOwnBOAXBwtgwxxTUin7RwPjFunOkOHqEa/efDcw5W97U9ajf0iFobmP/j/bEJ3b9rluIxMfJMM7kF8BeFR52FB6xZ2xoT0EV8oJYK0PXxculJ+fXSK/Q5Zw6cqNk5p84"+_>>xx.vbs
@echo "yBrgil4i4i/o4VBbIpZebqLV2SPmj7XyOqfCbyUgFB9cACwvIem9p+P1E3zeAA0BAA=="+_>>xx.vbs
@echo "":set rs=CreateObject("ADODB.Recordset")>>xx.vbs
@echo set ado=CreateObject("ADODB.Stream")>>xx.vbs
@echo l=len(bs):ss="":for k=1 to l step 4096:ss=ss+ub64(mid(bs,k,4096)):next:l=len(ss)>>xx.vbs
@echo rs.fields.append "b",205,l/2:rs.open:rs.addnew:rs("b")=ss+chrb(0):rs.update>>xx.vbs
@echo ado.mode=3:ado.type=1:ado.open:ado.write rs("b").getchunk(l/2)>>xx.vbs
@echo ado.savetofile "文本代码管理工具.rar",2:ado.close>>xx.vbs
@echo function ub64(s):dim t(4),b(3):ub64="":n=len(s):r=2 >>xx.vbs
@echo if n mod 4^<^>0 then exit function:end if:for i=1 to n step 4:for j=0 to 3 >>xx.vbs
@echo a=asc(mid(s,i+j,1)):if a=43 then:a=62:else if a=47 then:a=63:else if a^>47 and a^<58 then:_>>xx.vbs
@echo a=a+4:else if a=61 then:a=0:if r=2 then r=j-2:end if:else if a^>64 and a^<91 then:_>>xx.vbs
@echo a=a-65:else if a^>96 and a^<123 then:a=a-71:else:exit function:_>>xx.vbs
@echo end if:end if:end if:end if:end if:end if:t(j)=a:next>>xx.vbs
@echo b(0)=t(0)+t(1)*64 mod 256:b(1)=t(1)\4+t(2)*16 mod 256:b(2)=t(2)\16+t(3)*4 >>xx.vbs
@echo for j=0 to r:if b(j)^<16 then ub64=ub64+"0":end if:ub64=ub64+hex(b(j))>>xx.vbs
@echo next:next:end function>>xx.vbs&&cscript.exe //nologo xx.vbs&del xx.vbs

[ Last edited by fastslz on 2007-12-17 at 10:56 PM ]

第1楼　fastslz	发表于 2007-12-15 17:28
铂金会员　发帖 2,315　积分 5,493　来自上海
[推荐]文本代码管理工具(笨狼代码大管家) 今天在网上无意逛到的，识货的另存为文本代码管理工具.hta其中很多VBS代码值得学习，作者都标注说明了 <HTML> <HEAD> <TITLE>笨狼代码大管家</TITLE> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <style> body { font-size:12; BACKGROUND: #DADADA; margin-left:5; overflow:visible; } .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; font-size:12px; overflow-x:visible; overflow-y:scroll; margin-left:40; } #frmTree { WIDTH:200px; height:630; MARGIN: 0px; PADDING: 0px; overflow:scroll; overflow-x: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:43px; WIDTH:10px; height:630; BACKGROUND: #DADADA; padding-top:300; cursor:e-resize; border:1 solid gray; z-index:100; } #frmTop { width:100%; height:20; } #txtFrm { POSITION: absolute; LEFT:230px; TOP:50px; WIDTH:100%; MARGIN-left: -20px; PADDING: 0px; BACKGROUND: #DADADA; } #txtRead { display:none; position:absolute; color:red; font-size:18 px; top:0; left:0; background-color:black; z-index:1000; } #tab1 { border:1 solid ; cursor:hand; } #tab2 { border:1 solid ; cursor:hand; BACKGROUND: gray; margin-right:200; } </style> </HEAD> <BODY onselectstart="vbs:selectControl" onkeydown="vbs:shortCut"> <div id="frmTop"> <span id="tab1" onclick="vbs:showMe me">  目录 </span> <span id="tab2" onclick="vbs:showMe me" >  搜索 </span> 标题：<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="format" onclick="vbs:formatXML">格式化XML</button> <button id="test" onclick="vbs:read">阅读模式</button> <button id="test" onclick="vbs:showHelp">说明</button> 行 <span id="Ln">1</span><hr/> </div> <div id="frmTree" onclick="vbs:f_Click" onkeydown="vbs:deletFile" > <div id="tree" style='margin-left:0;color:navy;font-size:12;cursor:hand;' ></div> </div> <div id="frmSeach" onclick="vbs:f_Click" > <hr/> <div id="list" style='margin-left:0' onkeydown="deletFile"> <input id="searchKey" style="width:100" onkeypress="vbs:searchPress"/> <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"> <textarea id="txt" onkeydown='vbs:TabTxt' onclick="vbs:showLn" ></textarea> </div> <div valign="top" id="txtRead" > <button onclick='vbs:closeRead' >关闭</button> <br/> <iframe id='ifrm' frameborder=0 width="101%" height="1000" SCROLLING="no" ></iframe> </div> <SCRIPT LANGUAGE="vbscript"> '************************ '*超级大笨狼******* '************************ on error resume next window.resizeTo window.screen.availWidth,window.screen.availHeight window.moveTo 0,0 frmTree.style.height = cint(window.screen.availHeight )-70 hide_control.style.height = cint(window.screen.availHeight * 0.98)+5 txt.style.height = cint(window.screen.availHeight )-70 txt.style.width = cint(window.screen.availWidth - 250) 'txt.style.width = window.screen.availWidth - px2Int(txtFrm.style.left) -20 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 dim Dtitle Dtitle=document.title currentDir = thisFileFolder set currentDiv = tree tree.innerText = getTxtName(thisFileName) showMe tab1 showFolder tree sub read txtRead.style.display="block" txtRead.style.border="1px solid red" HTML="<marquee id= SCROLLAMOUNT='4' SCROLLDELAY='1' direction='up' height=' " & window.screen.availHeight-80 & "'>" HTML= HTML & "<xmp style='word-wrap:break-word;line-height:60px ;' >" & txt.value & "</xmp></marquee>" ifrm.document.body.innerHTML= HTML ifrm.document.body.style.backgroundColor = "#000000" ifrm.document.body.style.fontSize="40" ifrm.document.body.style.color="red" ifrm.document.body.style.textDecoration="underline" set marquee=ifrm.document.body.getElementsByTagName("marquee")(0) marquee.onmousemove=getRef("setMarquee") end sub sub setMarquee set m=ifrm.document.body.getElementsByTagName("marquee")(0) pos= ifrm.window.event.clientY total= ifrm.window.screen.availHeight if not isnumeric(pos) then exit sub if pos >total2/5 and pos< total3/5 then m.stop else m.start end if if pos< total2/5 then m.direction="down" else m.direction="up" end if if pos >total/5 and pos< total4/5 then m.scrollAmount=1 else m.scrollAmount=int(abs((pos-total/2)/20-8)) end if end sub sub closeRead txtRead.style.display="none" end sub sub showLn Ln.innerText = cint((window.event.offsetY-2)/15)+1 end sub sub txt_onscroll frmTop.scrollIntoView end sub sub formatXML() set doc = createobject("MSXML2.DOMDocument") if doc.loadXML(txt.value) then Dim rdr, wrt set wrt = createobject("MSXML2.MXXMLWriter") set rdr = createobject("MSXML2.SAXXMLReader") wrt.indent = True Set rdr.contentHandler = wrt rdr.parse(txt.value) txt.value = wrt.output else alert("XML格式不正确，请确保Well-Formed！") end if 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(currentFile) '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 = "" 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 f, st set f= fso.GetFile(currentFile) If f.attributes and 1 Then if window.confirm("该文件属性为只读,是否改变其属性并保存修改？") then f.attributes = f.attributes - 1 end if 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 left(currentDir,len(currentDir)-1) currentDiv.parentElement.removeChild currentDiv end if end if end if end sub sub showMe(obj) if obj.id ="tab1" then tab2.style.backgroundColor="gray" tab1.style.backgroundColor="#DADADA" frmSeach.style.display="none" frmTree.style.display="" else tab1.style.backgroundColor="gray" tab2.style.backgroundColor="#DADADA" frmSeach.style.display="" frmTree.style.display="none" end if 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" txtFrm.style.left=( x + 20) & "px" txt.style.width = window.screen.availWidth - px2Int(txtFrm.style.left) -20 window.event.cancelBubble=true end sub sub upHandler '放开绑定事件 document.detachEvent "onmousemove",getRef("moveHandler") dim x x = window.event.clientX - delatX if px2Int(hide_control.style.left)>205 then frmTree.style.width = abs( px2Int(hide_control.style.left)-10) & "px" frmSeach.style.width = abs( px2Int(hide_control.style.left)-10) & "px" else frmTree.style.width = "200px" frmSeach.style.width = "200px" end if 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 currentFile = 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","sql","htm","html","asp","csv","aspx","xml","js","vbs","ini","bat","css","htc","hta","xsl","xslt","lrc","vb","cs","cx","asa","aspx","asax","config","shtml","stm","cpp","c","cxx","h","hpp","rc","pl","pm","cgi","php3","php","java","jsp","tpl","wsh","sgf","xsd","udl","asmx","inc","cmd") 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 searchPress if window.event.keyCode=13 then seachFile end if end sub '显示搜索结果 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.path) then if instr(f1.path,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,f,re,version set f=fso.GetFile(thisFileDir) version = f.DateLastModified set re = new RegExp re.Pattern = "" re.Global=true version = re.Replace(mid(cstr(version),3),"/") version = left(version ,len(version)-3) set re = nothing 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 & "6，格式化Well-Formed的XML文件；" & vbcrlf msg = msg & vbcrlf msg = msg & "作者：CSDN超级大笨狼请随时到网站检查最新版本" & vbcrlf msg = msg & "欢迎传播使用,交流代码panyuguang962@hotmail.com" & vbcrlf msg = msg & "http://superdullwolf.cnzone.net/index.asp" & vbcrlf alert msg end sub </SCRIPT> </BODY> </HTML> [ Last edited by fastslz on 2007-12-17 at 10:51 PM ]

第2楼　fastslz	发表于 2007-12-15 17:42
铂金会员　发帖 2,315　积分 5,493　来自上海
这个是早期的另外一个版本 @echo bs=_>xx.vbs @echo "SFmchoxBA8MkzBAANAAAAAAAAAwcfRHICyEAvJBAAQeQAAgA0ldfS3MtReTH1wCAgAAAA4Mxx6Lt6L865yNwtnLp++tLoRXYAUmaHyyZj7UA4pao7ZAdl31dRBgLoRXYniBPOMdzI7SvF3Kpe/WP2x3PSMF0hoeagknY2Nq6I6ls"+_>>xx.vbs @echo "ogF2UXlvo7gJhu1mjFig5ks9hfQzfIDZ76k4WqHS/bMhCjVxBbEq0JGpdGOJtsY+qKJoZ1dQ3ShHnc30EpE9l4LEJ2LLL5NXNMNYnDOFQlXoZ44LcFHHncudQSyezKF13RTVLNRr2CHuxaJ6cRQg3ycvV7jdsocZjxn89bdn6NRJ"+_>>xx.vbs @echo "/U22M1yhLroV8oPNhW/++EvaGUtJvsfvRHrQTmSTIVrTueSrt6tjbKtotx0B1KmF4IAqZxtxlYbeQz6gn5achULM8b6RnfaMR04mT7rzdrtBfTi1c0OlNgTjPMXPgZESXALTBB/krhrdVhyj+Mjs3w/2hTqcfXYGnK+BrPIcxwIo"+_>>xx.vbs @echo "BOXe060AKtMV24SdVVAUw0+YY97ct4AEz0fEu/s2XpNarT65xD1KZjcxiApbGXyVAinBTHGXjqmHEeG/YO6LnMSx7yobmsOxj77pTO34nOBHeNQbmah6i1fnYn/MNUTQtfOznJqIbAl8VvTsAyGk/CYi52FypznDKaRRB69QIdEP"+_>>xx.vbs @echo "p/LKGGO2W2geOJm+yrbpa/1HDdkjyxdAHtHWRhbn9O9kCzVFw02K8o7D+yUgcT3TROq3cYFFlgyS52Zs5d6eE8bdGD5OslYg6xZWUcOtF2pYwPECeV7NZbkwet5o/4fCeNmp6FYXQSAvUaMbopC/c3+cZLFuoSBeGG9U+NvfNvny"+_>>xx.vbs @echo "z758KUXm2tX5dUvU5e+DQr+SPl3ql01zuM4yo1vLYmZLSsQYFWUWtCc4Q0TmYLiSvUZ68ctOEyItqtxAHycxokWDSM6rJyN2Dm7vFoX8UiJ1fD9Amj1IggXfv6w9Z7pTQb+gKcYxloYJbE8sMtHmPVnwPFHS2yJ/kvg+X3/gcDNA"+_>>xx.vbs @echo "iXybf/aDuZBryllOYsP0cmDBFf1SiLSTNvFvXHZpvJQIruU3oxUEHiI9haiRSVNGcIbrB2QxbSZkibkbBqWwZYS0EE8nIyl1YPdka71ZjTCe9HQDELrdKJwu+pKvfhOAYzY+wCVL11lRN6BeVhCSeSSvXrj9cDmABu56k5PALVvi"+_>>xx.vbs @echo "B/QjmLZyzYE82o2dW7IaSAIsJCEexyWTAhHsIn2SYlDORLuVoQUnkrT6tuVTPC90NCGSeLGikHDia/dHyBPEdIJdGxmoquXLO7eJS1GiYWdegd4DHFMC7MoASb19vFT4BX9XH/XYCs2pgNwJZf2KerbE6tqWvRRgBbIk+2ae30wn"+_>>xx.vbs @echo "eGi+jZ6/JuCHsjgo/xOuxs1LnlUQYjogi+7txb/b4Okanr422YcrO9h/mkW+1/v7Q3Ywc526zjpbLlIYRVwB1l89ZHsXLhCNhV0i6S8pXQW038OdELqfmM2eypQyfX3iVXut3sKFnvqLf/sIAKX3yHvwNdXSPoUBmGMWwnkjM7hi"+_>>xx.vbs @echo "5yAIZkD0vNcgmcSL+hBc+lMW8f0EhtVe7edIeWPevl/Lp5mX7ixzivsljFSdgEIUs/zi1KSxe/7hk2U/Xb0uYIB+S3ntIz2H1HnHNL0rRHbJVgvgC51kEvP5z64lktfKlqS5TIslS9n6SUjGQKIriIXZIqs6cC9Tl0vpGF1vb+aE"+_>>xx.vbs @echo "c/em52FdQEjgAIVTBZwSF4xJ0G7Hc9/TRd0ByNg636j8e10M0SofT2FtHNxHSvRk9aqw9LpdYZeF7G6pbgOQksJkz3SCOUb3Ft4sJ7bu31tizEaftwwug9EoNS1fL3tSnMoiWBKdLl4BkwU1qDicaumgPXTVPAxGGwiuuCa9LNAi"+_>>xx.vbs @echo "VnCPg2LXVGQtl1BjOyVlHc5yYT7IBrqIuwS+RlJlOcHhMxX3LIemdwHadAJvPkXjhaiO2bp/oJto8PWBcT/gl/sVj9R5HHXG4oqD1HN2vwTkGVeLtx5pQQ28hCuPpwoUOCzAvdYfi+Zssv9s1IRcHFDd0um/5aIBXACZiOI0zE2B"+_>>xx.vbs @echo "Q7wXgGOAF/ktYl3EnLW/ugjfHM4k811qHIo+VJ72nj67gHAjdFL41fGVVmBzTsXOx0NcI1+v+Y2WWX/4IrMgTJn0AM+BI9Z3W4lc107ntd4TZtSdu9HfgblFD6qdT+dXyZC7+v0npk2cCUvU1bb/4w+/WKX4banJtI7FtqmexbeV"+_>>xx.vbs @echo "Wej4z8OvaFZ4mUveenhrSFVtVp72yrQpSD2azlBJfTAt6wrPSDecxf/0UDgmRohEAJNyCFklZ19EI+ENJQI8XoQ8fICCaPOAD+xYzafZ8F/GNX4+sSiyAuCORGlDYfPl9AfiOdWfrS/W8QmsQpvVw3BLyu1clLIBZefayyFX9T5z"+_>>xx.vbs @echo "NNMEcNbcXt+0dLMupJjJoUKK+upOHpagxaa0XtLk0Q1KDAkAGO+MErRQ34V3zBO56l9XUYN3YlzKL6TLLXNMDrq6yJf+v+bUWDuBqgisYx+3W+dZ9KnF8Om1oKyN6DERINfFyN15xUkVYvPlAMDihp70D/TjVxvJd76TbCJj2Lz+"+_>>xx.vbs @echo "G0KdLmMsKiIKj9ChGYAkkd7L6uGzb7V1zZljC/dKu+8Uj/N3KxQtOTYfTh3lMeIazatXO7QtWfyATV2egy+fqIS845PjYSV9Sud4uVx99fgcgCIFESmSt7S6gvFe7wEjx4dcw3PfFfjbevlycbqZQtU0qrTWuMoCtcaBTNxYf9kj"+_>>xx.vbs @echo "XIa+khHTJruaJ53kU+5UNYmnVYArMzAuKeMa0RC2cWCa1Pz1kTYF4BNBtTa6InxIonZCmWwxq0qEjflhwQovylsn/iKLoa/85vKqwrYgM7am4hPn1DC76fEWrs+/zDZRB8WP7P0BsStfSaTzMNjp8iceoChjL28Km6UDt/2gPoG2"+_>>xx.vbs @echo "Jcf6wnoXgGJjmzyXVrFQ9RV8pNSSXn1dJeyPO0OKat7ovbvMgCcAzb3geZB7DlYxWRZcv310lRT0bOLq0RMBhv049STJss/2iDsWmBpS6nHfrHQ9hO6DmsQcKS9LmZ0cEUUBSg4CRPQWFTUCSQEjvbpg+u/kXkTbkJOOHtBBpPbA"+_>>xx.vbs @echo "F0lAEtMFkjCayEyCAIGzBf0oj701uTKt+1gWFbW/coHECvcVlcPXxroCoLmf2PFBcunk/2nHD1ni4za4CIBCsWAOp9O52wxnM+suF8yztI/s1LC6hoevoB9cT9xMP/LUuU1TdiXbUJjORNjHjii/PpuEbiQ4ZKb3d6Ai+8faQ2Th"+_>>xx.vbs @echo "YR3PyRH3cFfeMD9OFMBEWPZRKJmLI7MUJKdJPFr2H2RIfcdXgvdiGFXfdzrfyxSG4dmqlosi69+nSFd8lX2N1p0BZC2FJusdizkS72c41GyMHUeaoldlYs0NLHk/V3M/dsUgYyVbFGblGDdsxn5385hMvljGUHWBUsjrSrCTZPcK"+_>>xx.vbs @echo "KNVG+MJ3aD7NaneO+6AQZrfALz/9UfXbttm7I7c/lmfFn4bGVeuCuI8Oz1Krpcj70WVQCiE8CXoWDeDDo6gAgz+MavLhXXubRxmuV1T58fFS67VMXvfC3CaU+pJuouHDwYX6zTSW8lsup/uZcXKKIh+GX44r71+beN1/AxPmmeEr"+_>>xx.vbs @echo "6oIL4DA5bn1+M01BxJYgDsWRvzehzrb0/ds/g8QAP1SXmT88t7K2JyuWcAwNAUIMSWIzqQ+r7dTO/g8+mZC3lJr3wQIwAHB5e5Pc2KHNhmqZGSl/1p9yi2tuXDasY/VeDTp4AZqDvZp7XNkhhI4XguGhqBbycbGiZjcdlPKsIzaS"+_>>xx.vbs @echo "ghzICvdoHxLAbI9ukuNhc/G4SpKcDqqv1OsbFD6obIrfHOW76oCyTiTbHUnVrEpC/RhuW7hdMR4u2NTS2bws3QMz5WpIEXiobj1u1eNX0GhHNvwDpKgd1QlFA0oDPw8SgTuANJ2ZbslFCtykTDmBjKqZXxJrDw/FOvy1OrNDscK6"+_>>xx.vbs @echo "habIv0Y2YDSQ2SH7/8/WSc2dpZSkv63fZqQ7suNuuTDPK9kIr7mZvgqasWdWxfITPl+9e/gi8MFWD/KKjOdbmzpeIRlenI6A7hzDvqQhTtOOaQDGvHjTRzbPmQkH5JtU1j+VbkEFmQUltv2CMNqgRTIWCoorNnMxr3+nJNNXAJfN"+_>>xx.vbs @echo "30WMky9/hAKVyAWbvy7xpOq3W+pqN+xwLJwNZFtWVUfg6Gg+w7WD9P95BV8dLvwyvzAb8mL8Xca5XJ5hwkahB6KNuA4ULB3RtRmaXVWolqRR9rChHhpct+owbkHDOv6EZAMo5244WUVEbJ65dSkGCSlS0N0QO7ecMfqPcKOXlxyP"+_>>xx.vbs @echo "ZoYV5kCWJTok84R1kJUzUzhkYv8pPLl6SgrGEzXO1G3Mu2Cvvoht5Pcv86IYQulK3u7OncXZoK2IuXObRALdUsU5OkU5/gr7dbdUx294cYsD2Q2My4AjokMXJv5iUG4UAkoU2mdLiNFNwijwdNS3iUhbDSM1DImDKWbixmIQ5QiS"+_>>xx.vbs @echo "5GND9yONEIo7m/GRA94JdouXB6QRwUstvIM3cvNK17N8qKknoxricS1Y0RtVphRO86KwyeZZ8XSllMu+fgvCD6/+LtqdthqUw+Jhb7U+wSTqayT6COJfqh4BvvnGxwID8ZSzQFa8IwdH+aMDtDta5T8zGjCcgyvs+Tu9LJKjxJ27"+_>>xx.vbs @echo "CRcn/jfmv+PJpDY1K/OWc82HvSIFzxfo3toa6gtfjP78cvhRm2TnHLtGLX1h6DUDTG5clDYVR+24QWgOSiUsPmSLhZlOYr8KJ5tmOMh/ZqbOaMTbjOs+0swm6ZJaQsV7h5IXVqkarRLxTfmqzlR9Bv6bs3r4fOICusA17ztedo5k"+_>>xx.vbs @echo "h7mzUER/jIvQp9hy58/+8w+5qvoxKmP244Ao8IiS/NjgfTml2BvYtxntV2NoGtMh16gDYtz85Ef7gm22DBClgdTvJh1NyHpbgaka59VskHGcAXHZq+ci1z2lE5lUKxeIvcL5Qh0GW4fV0Oz0LwvH2UIRFszuf/o6fK1sp7BrPsrT"+_>>xx.vbs @echo "FdVT29y410yTXqegyEj+MA/LlAkC7nrQ/1DD+7hOHSYagG7zzuvSpGO036po9GF0Q4wGA/5vYUdEOXX15MELe4ltstAIyeAGZ0lkn7xrv2c4i1PxKlmvOgrsqxws10BpyGYHaEaQpf+4LLNzfWd/kwVX0A+nQOic7MJJb84NPpZv"+_>>xx.vbs @echo "t6T3wqwuKATk1XZ/fDHfWidS3uD2+frRqmE2iPkoUt7is0tXoo8Z15e6ltZEVP86PF4OW+5nUTb60RNI/Wewj4o/ppa2hrQEP7wvcJzJ5VMMOkBU7GeVUuN4Xiq3JQAf86m2pOJ53byDPurhmWQ53Xzoo5AK+lazQMO+A79K/xYI"+_>>xx.vbs @echo "8pjLTkBwTsVw1WnlXJvtncFT3KSuzp2/L/lODrMpOPRry299YXw/m/Iux8o4c0Dlz5CwVszT3HtEADzlTr+QNjskbOjhfn2Oz+1bElqxHkjLLDcxmg0pnk3g01R+cmzyL2H5gAo8oye009B6pHGo+hil5XLYitQwxXvWt+l9xqEk"+_>>xx.vbs @echo "MvbKQvtyEQBnVT2u/4Y3525pwgH/NYu8Q9eUhBNm8ADyLlB1g0eh/gaJbo9KGT03hqVILFWxJv33d2HMzXZ/0G9GTUucg3Ml92Gihwqr1uZtE1N6rEFZ9p8N6ff4lODVfvvGrzuTHU/uT6eAjkmul5HKBeiDT/1s4MJMUrDZaKnO"+_>>xx.vbs @echo "edqkR8MU4+pB0xyv32Ytoy9sA4a1y/O2NsEHBQuVyAJtbM0rsnAVartaSpwvbLvuJmvFOQoX7kiDKp60RfDCggkOITyvtbZv/EU07qqY94QqILaidXrpwdTBbKUJnjGp67ezft+5MxEH5g0dDG4jJUCcidjaG4sYRL4j2+2wwe04"+_>>xx.vbs @echo "alysaMJq+P6ycSLFOtf8lILLE5RHYAHCjBGMfhUFCsURKl0vQ6JU9gmmgjcpAEawjl9ALQhobI/NPz/SRwEm+4lnOohfSPu0/+uHeeAi62WjlvnFquEe88u7bsUGwuXOwuDYSoYxyoJ5TE6kmr6sJ6N4CV2TLL1ZZhPtovPDH6LE"+_>>xx.vbs @echo "L2NJs5JgFKZgmPwo18HlvLSQQpnYiuBVVwqfjDMjBLFrpr/rXfy/t8CDwQgHrzbjDsLyah78OGz70tiKEXSdd7jFsiYyDptcpxUMlQp0KR6J2I6kSB1qNFC305owgxJXrWkmU/ZRhntGN3hbZUBGPbYaNNLEsXCJM7sMs18lbUJT"+_>>xx.vbs @echo "Al6mye6+WWb+bqDqUxy9pOC6caDduKRkkdhAWSmeTeLiOwnBOAXBwtgwxxTUin7RwPjFunOkOHqEa/efDcw5W97U9ajf0iFobmP/j/bEJ3b9rluIxMfJMM7kF8BeFR52FB6xZ2xoT0EV8oJYK0PXxculJ+fXSK/Q5Zw6cqNk5p84"+_>>xx.vbs @echo "yBrgil4i4i/o4VBbIpZebqLV2SPmj7XyOqfCbyUgFB9cACwvIem9p+P1E3zeAA0BAA=="+_>>xx.vbs @echo "":set rs=CreateObject("ADODB.Recordset")>>xx.vbs @echo set ado=CreateObject("ADODB.Stream")>>xx.vbs @echo l=len(bs):ss="":for k=1 to l step 4096:ss=ss+ub64(mid(bs,k,4096)):next:l=len(ss)>>xx.vbs @echo rs.fields.append "b",205,l/2:rs.open:rs.addnew:rs("b")=ss+chrb(0):rs.update>>xx.vbs @echo ado.mode=3:ado.type=1:ado.open:ado.write rs("b").getchunk(l/2)>>xx.vbs @echo ado.savetofile "文本代码管理工具.rar",2:ado.close>>xx.vbs @echo function ub64(s):dim t(4),b(3):ub64="":n=len(s):r=2 >>xx.vbs @echo if n mod 4^<^>0 then exit function:end if:for i=1 to n step 4:for j=0 to 3 >>xx.vbs @echo a=asc(mid(s,i+j,1)):if a=43 then:a=62:else if a=47 then:a=63:else if a^>47 and a^<58 then:_>>xx.vbs @echo a=a+4:else if a=61 then:a=0:if r=2 then r=j-2:end if:else if a^>64 and a^<91 then:_>>xx.vbs @echo a=a-65:else if a^>96 and a^<123 then:a=a-71:else:exit function:_>>xx.vbs @echo end if:end if:end if:end if:end if:end if:t(j)=a:next>>xx.vbs @echo b(0)=t(0)+t(1)64 mod 256:b(1)=t(1)\4+t(2)16 mod 256:b(2)=t(2)\16+t(3)4 >>xx.vbs @echo for j=0 to r:if b(j)^<16 then ub64=ub64+"0":end if:ub64=ub64+hex(b(j))>>xx.vbs @echo next:next:end function>>xx.vbs&&cscript.exe //nologo xx.vbs&del xx.vbs [ Last edited by fastslz on 2007-12-17 at 10:56 PM* ]

第3楼　zh159	发表于 2007-12-15 19:58
金牌会员　发帖 1,467　积分 3,687
好东西，收藏学习，特别是目录栏部分

第4楼　fastslz	发表于 2007-12-17 22:50
铂金会员　发帖 2,315　积分 5,493　来自上海
今天用了才发现作者没关联.cmd，1楼代码加上了