FSO's powerful features _FSO special topics

Source: Internet
Author: User
Tags abs chr closure tagname
<HTML>


<HEAD>


<TITLE> stupid Wolf code big Butler </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" > Directory </span>


<span id= "tab2" onclick= "Vbs:showme frmseach,frmtree" > Search </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" > directory </span>


<span id= "TAB4" > Search </span>


<hr/>


<div id= "list" style= ' margin-left:0 ' onkeydown= ' deletfile ' >


<input id= "Searchkey" style= "width:100"/>


<button onclick= "Vbs:seachfile" id= "SearchButton" > Find </button><br/>


<div id= "seachlist" style= ' margin-left:0 ' > Search results </div>


</div>


</div>


<input type= "button" id= "Hide_control" onmousedown= "Vbs:begindrag" onmouseup= "Vbs:uphandler" bgcolor= "#eeeeee" >


<div valign= "Top" id= "Txtfrm" >


Title: <input id= "ArticleTitle" style= "width:100" readonly/>


<button id= "Browse" onclick= "Vbs:browseme" > Preview </button>


<button id= "Savebutton" onclick= "Vbs:savefile" > Save </button>


<button id= "Browse" onclick= "Vbs:createfile" > New </button>


<button id= "test" onclick= "vbs:showhelp" > Description </button>


Line <span id= "Ln" >1</span>


<textarea id= "txt" onkeydown= ' vbs:tabtxt ' onclick= ' vbs:showln ' ></textarea>


</div>








<script language= "VBScript" >


'**************************


' * * * * * * * *********** Wolf


'**************************


On Error Resume Next


Window.resizeto Window.screen.availwidth,window.screen.availheight


Window.moveto 0,0





Set fso = CreateObject ("Scripting.FileSystemObject")


Dim Thisfiledir ' Defines the absolute path to this file


Dim Thisfilename ' defines this file name


Dim Thisfilefolder ' Defines this folder path








Thisfiledir = replace (window.location.href, "file:///", "")


Thisfiledir = unescape (replace (Thisfiledir, "/", "\"))


Thisfilename = LaStone (Thisfiledir, "\")


Thisfilefolder=getfolderdir (Thisfiledir)


Tree.title = Thisfilefolder





Dim Currentdir ' Current Path


Dim Currentfile ' Current File


Dim Currentdiv ' Current Div object


Dim Currentspan ' Current Span object


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


' Dot Create button, really created.


If VarType (currentspan) <>0 then CurrentSpan.style.color = "Navy"


If Currentdir = "" Then


' If you point to a file


Currentdir=getfolderdir (Currentfile)


Else


' Dot to the folder


Dim n


Set n=currentdiv.nextsibling


Todo


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 & "New Collection" & Re. Replace Mid (CStr (now), 3), "") & ". txt"


Currentfile=newfile ' new file is the current file


' Tectonic 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= ' V Bs:rename me '/> '


s = S & "</div>"


' Insert 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"


' Create a file


Set F=FSO. CreateTextFile (NewFile)


F.close


End Sub





function Getfolderdir (fulldir)


' Input get full path, get folder path


S=lastone (Fulldir, "\")


Getfolderdir = Left (Fulldir,len (Fulldir)-len (s))


End Function





Sub SaveFile


' Save changes to the file


Dim St


Set st = fso. OpenTextFile (Currentfile, 2, True)


St. Write Txt.value


St.close


End Sub








Sub Deletfile


' Delete file


Dim n


If Window.event.keyCode =46 and window.event.srcelement.tagname<> "INPUT" Then





If currentfile<> "" Then


If Currentfile = Thisfiledir Then


Alert "is not allowed to delete this file! "


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 "does not allow root directory deletion! "


Exit Sub


End If


Set n = currentdiv.nextsibling


If Window.confirm (Currentdir & vbCrLf & "This file has a child file, do you want to delete all the subfolders?") Then


Todo


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


' Start dragging


Delatx=window.event.clientx-px2int (Hide_control.currentStyle.left)


Document.attachevent "OnMouseMove", GetRef ("Movehandler")


Dragable = True


Window.event.cancelBubble = True


End Sub





Sub Movehandler


' Move binding Event


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 +) & "px"


Window.event.cancelbubble=true


End Sub





Sub Uphandler


' Let go of the binding event


Document.detachevent "OnMouseMove", GetRef ("Movehandler")


Dragable = False


Window.event.cancelbubble=true


End Sub





function Gettxtname (fullName)


' Remove filename suffix


Dim S:s=lastone (FullName, ".")


Gettxtname = Left (FullName, Len (fullName)-len (s)-1)


End Function








Sub ReName (obj)


' Renamed


Dim arr,a


Arr=array ("/", "\", ":", "*", "?", Chr (), "|", "<", ">")


For all A in ARR


If InStr (obj.value,a) >0 Then


Alert "name cannot contain/\:*?" & Chr & "|<> one of them"


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)


' Enter characters and delimiters to get the last part


LaStone = Right (Str,len (STR)-instrrev (STR,SPLITSTR))


End Function





Sub Selectcontrol


' Control the status of page selection


If window.event.srcelement.tagname<> "INPUT" and window.event.srcelement.tagname<> "TEXTAREA" Then


Document.selection.clear


End If


End Sub





function Istxt (FILENAMESTR)


' Judge whether it is a text-type file


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 all 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 & "This folder does not exist, may be moved, so refresh this program"


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.ma Rginleft, "px", "" ") + 8 &"; > "


s = S & "<span class= ' Foldericon ' >0" & "</span><input value= '" & Sf1.name & "' ReadOnly sty Le= ' 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"


' Dot to the folder


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


' Closure





Fold d,state


Else


' Parse


Showfolder D


End If








Case "Fileicon"


' Point to the file, load the text file inside the 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) ' closure


Dim n


Set n=o.nextsibling


Todo


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 & "The file does not exist, it may be moved, so refresh the program"


Window.location.reload


Exit Sub


End If





' txt already loaded current file is no longer loaded.





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-enabled text box


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


' Press 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


' Not pressing 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





' The following is about searching


Dim Seachresult ' Find Results


Dim num ' Result Quantity


Dim word ' Search for keywords





Tagstop = False


Seachresult = ""





Sub Seachfile ()


Num =0


Seachlist.innertext = "Search Results"


Word = Searchkey.value


Seachresult = ""


If trim (word) = "" Then


Alert "keyword is empty! "


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 = "Search Results"


Seachword Thisfilefolder


Seachlist.insertadjacenthtml "Afterend", Seachresult


Seachlist.innertext = "Search results:" & num & "A"


Alert "Search Complete! "


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


' Read-by-line '


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 = "Text Code management tool" IE5.5 above Version "" & vbCrLf


msg = msg & "------------------------------------------------" & vbCrLf


msg = msg & usage: Put it in a text-type folder, double-click to run it. "& vbCrLf


msg = MSG & "Features:" & vbCrLf


msg = msg & 1, quick browse, preview ctrl+b, search text type files and code; & vbCrLf


msg = msg & 2, press Del to delete the files and folders in the point; & vbCrLf


msg = MSG & "3, can modify file name and text content, Ctrl+s save;" & vbCrLf


msg = MSG & "4, you can create files Ctrl + N and edit save;" & vbCrLf


msg = MSG & "5, Text Editor support tab and Shift+tab key;" & vbCrLf


msg = msg & vbCrLf


msg = msg & "Author: csdn Super Big stupid Wolf [2005/1/18 version]" & vbCrLf


msg = msg & "Welcome to spread use, AC code panyuguang962@sohu.com" & vbCrLf


msg = msg & "http://superdullwolf.cnzone.net/index.asp" & vbCrLf


Alert msg


End Sub


</SCRIPT>





</BODY>


</HTML>








Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.