Tutorials to .com

Tutorials to .com » Asp » Fso » The power of FSO

The power of FSO

Print View , by: iSee ,Total views: 22 ,Word Count: 3734 ,Date: Thu, 16 Apr 2009 Time: 4:44 AM

<HTML>
<HEAD>
Stupid wolf <TITLE> big code </ 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"> Help </ button>
Line <span id="Ln"> 1 </ span>
<textarea id="txt" onkeydown='vbs:TabTxt' onclick="vbs:showLn"> </ textarea>
</ div>


<SCRIPT LANGUAGE="vbscript">
'**************************
Super stupid wolf'***** ***********
'**************************
on error resume next
window.resizeTo window.screen.availWidth, window.screen.availHeight
window.moveTo 0,0

Set fso = CreateObject ( "Scripting.FileSystemObject")
dim thisFileDir 'definition of the absolute path of this document
dim thisFileName 'definition of the file name
dim thisFileFolder 'definition of the 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 [AutoPage]
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
'Point to create the button, it has created.
if vartype (currentSpan) <> 0 then currentSpan.style.color = "navy"
if currentDir = "" then
'If you point to the file
currentDir = getFolderDir (currentFile)
else
'Point to the folder
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 & "new collection" & re.Replace (mid (cstr (now ()), 3 ),"") & ". txt"
currentFile = newFile 'new document is the current file
'Structure 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>"
'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 to be the whole path, the folder path
s = LastOne (fullDir, "\")
getFolderDir = left (fullDir, len (fullDir)-len (s))
end function

sub saveFile
'Save changes to document
Dim st
Set st = fso.OpenTextFile (currentFile, 2, True)
st.Write txt.value
st.close
end sub


sub deletFile
'Delete Files
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 "is not allowed to delete the root directory!"
exit sub
end if
set n = currentDiv.nextSibling
if window.confirm (currentDir & vbcrlf & "this folder has subfolders, you have to delete all subfolders do?") 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
'Began to drag
delatX = window.event.clientX - px2Int (hide_control.currentStyle.left)
document.attachEvent "onmousemove", getRef ( "moveHandler")
dragAble = true
window.event.cancelBubble = true
end sub

sub moveHandler
'Mobile binding events
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
'Liberalization of binding events
document.detachEvent "onmousemove", getRef ( "moveHandler")
dragAble = false
window.event.cancelBubble = true
end sub

function getTxtName (fullName)
'Remove the file name suffix
dim s: s = lastOne (fullName ,".")
getTxtName = left (fullName, len (fullName)-len (s) -1)
end function


sub reName (obj)
'Name
dim Arr, a
Arr = array ("/"," \ ",":","*","?", chr (34 ),"|","<",">")
for each a in Arr
if instr (obj.value, a)> 0 then
alert "name can not contain / \: *?" & chr (34) & "| <> one of them"
obj.focus [AutoPage]
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 the characters and separators, the last part of
LastOne = right (Str, len (Str)-InStrRev (Str, splitStr))
End Function

sub selectControl
'Page to choose the state of control
if window.event.srcElement.tagName <> "INPUT" and window.event.srcElement.tagName <> "TEXTAREA" then
document.selection.clear
end if
end sub

function isTXT (fileNameStr)
'Determine whether the type of document text
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 & "The folder does not exist, may be moved, so refreshing about this procedure"
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"
'Point 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
'Analysis
showFolder d
end if


case "fileIcon"
'Point to the documents included in 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) 'close up
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 & "The file does not exist, may be moved, so refreshing about this procedure"
window.location.reload
exit sub
end if

'TXT have loaded the current document 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, "\") [AutoPage]
articleTitle.value = getTxtName (fName)
f.Close
Ln.innerText = 1
End sub

sub TabTxt ()
'Support for the text box tab key
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
'According to 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 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 on the search
dim seachResult 'search results
dim num 'number of results
dim word 'search keyword

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 & "months"
alert "search completed!"
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
'Line-by-line reading
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 = "the text of the code management tool】 【IE5.5 above" & vbcrlf
msg = msg & "--------------------------------------------- --- "& vbcrlf
msg = msg & "Usage: put the text inside the folder type, double-click to run." & vbcrlf
msg = msg & "Function:" & vbcrlf
msg = msg & "1, fast browsing, preview CTRL + B, search the text of the document types and code;" & vbcrlf
msg = msg & "2, press DEL to delete the points in the files and folders;" & vbcrlf
msg = msg & "3, can modify the contents of the file name and text, CTRL + S save;" & vbcrlf
msg = msg & "4, you can create a document CTRL + N and editing saved;" & vbcrlf
msg = msg & "5, text editor support for TAB and shift + TAB key;" & vbcrlf
msg = msg & vbcrlf
msg = msg & "Author: CSDN Super stupid wolf [2005/1/18 version]" & vbcrlf
msg = msg & "welcome to the spread of the use, exchange code panyuguang962@sohu.com" & vbcrlf
msg = msg & "http://superdullwolf.cnzone.net/index.asp" & vbcrlf
alert msg
end sub
</ SCRIPT>

</ BODY>
</ HTML>



ASP File System Object Articles


Can't Find What You're Looking For?


Rating: Not yet rated

Comments

No comments posted.