fso.hta

较为详细的介绍了asp自定义的各种函数,方便asp的各种开发.

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

</BODY>
</HTML>