⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fso.hta

📁 较为详细的介绍了asp自定义的各种函数,方便asp的各种开发.
💻 HTA
📖 第 1 页 / 共 2 页
字号:
<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" > &nbsp;目 录 </span>
<span id="tab2" onclick="vbs:showMe frmSeach,frmTree"> &nbsp;搜 索 </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" > &nbsp;目 录 </span>
<span id="tab4"> &nbsp;搜 索 </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>
行&nbsp;<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 & ";' >&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   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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -