我要评论复制代码 代码如下:
'-------------vbstree.vbs------------------------
'描述:用vbs输出一个文件夹的目录结构。
'------------------------------------------------
const unit4size = "字节kbmbgb"
const outfile = "outtree.txt"
dim theapp,selpath,treepath,treestr
set theapp = createobject("shell.application")
set selpath = theapp.browseforfolder(0,"请选择需要列出子项目的路径",0)
if selpath is nothing then wscript.quit
treepath = selpath.items.item.path
set selpathpath = nothing
set theapp = nothing
dim objfso
set objfso = createobject("scripting.filesystemobject")
treestr = treepath & formatsize(objfso.getfolder(treepath).size) & vbcrlf
tree treepath,""
set objfile = objfso.createtextfile(outfile,true)
objfile.write treestr
objfile.close
set objfile = nothing
set objfso = nothing
msgbox "查看当前目录下的outtree.txt",vbinformation,"完成 - vbstree"
sub tree(path,sfspace)
dim i,tempstr,flspace
flspace = sfspace & " "
set crntfolder = objfso.getfolder(path)
i = 0:tempstr = "├─"
for each confile in crntfolder.files
i = i + 1
if i = crntfolder.files.count and crntfolder.subfolders.count = 0 then tempstr = "└─"
treestr = treestr & flspace & tempstr & confile.name & formatsize(confile.size) & vbcrlf
next
i = 0:tempstr = "├─"
for each subfolder in crntfolder.subfolders
i = i + 1
if i = crntfolder.subfolders.count then
tempstr = "└─"
sfspace = flspace & " "
else
sfspace = flspace & "│"
end if
treestr = treestr & flspace & tempstr & subfolder.name & formatsize(subfolder.size) & vbcrlf
tree subfolder,(sfspace)
next
end sub
function formatsize(sz)
dim i
do while sz > 1024
i = i + 1
sz = sz \ 1024
loop
formatsize = " (" & sz & mid(unit4size,1 + 2 * i,2) & ")"
end function
文件夹浏览部分优化后的代码
复制代码 代码如下:
'-------------vbstree.vbs------------------------
'描述:用vbs输出一个文件夹的目录结构。
'------------------------------------------------
const unit4size = "字节kbmbgb"
const outfile = "outtree.txt"
dim treepath,treestr,ws
set ws = wscript.createobject("wscript.shell")
treepath = bff("请选择需要列出子项目的路径",&h0001 + &h0008 + &h0010,"")
set ws = nothing
if len(treepath) = 0 then wscript.quit
if len(treepath) <= 3 then msgbox "无法处理根目录！",64,"提示":wscript.quit
dim objfso
set objfso = createobject("scripting.filesystemobject")
treestr = treepath & formatsize(objfso.getfolder(treepath).size) & vbcrlf
tree treepath,""
set objfile = objfso.createtextfile(outfile,true)
objfile.write treestr
objfile.close
set objfile = nothing
set objfso = nothing
msgbox "查看当前目录下的outtree.txt",vbinformation,"完成 - vbstree"
sub tree(path,sfspace)
dim i,tempstr,flspace
flspace = sfspace & " "
set crntfolder = objfso.getfolder(path)
i = 0:tempstr = "├─"
for each confile in crntfolder.files
i = i + 1
if i = crntfolder.files.count and crntfolder.subfolders.count = 0 then tempstr = "└─"
treestr = treestr & flspace & tempstr & confile.name & formatsize(confile.size) & vbcrlf
next
i = 0:tempstr = "├─"
for each subfolder in crntfolder.subfolders
i = i + 1
if i = crntfolder.subfolders.count then
tempstr = "└─"
sfspace = flspace & " "
else
sfspace = flspace & "│"
end if
treestr = treestr & flspace & tempstr & subfolder.name & formatsize(subfolder.size) & vbcrlf
tree subfolder,(sfspace)
next
end sub
function formatsize(sz)
dim i
do while sz > 1024
i = i + 1
sz = sz \ 1024
loop
formatsize = " (" & sz & mid(unit4size,1 + 2 * i,2) & ")"
end function
function bff(title, flag, dir)
on error resume next
dim oshell, oitem, ostr
set oshell = wscript.createobject("shell.application")
set oitem = oshell.browseforfolder(&h0, title, flag, dir)
ostr = oitem.title
if err <> 0 then
set oshell = nothing
set oitem = nothing
exit function
end if
if instr(ostr, ":") then
bff = mid(ostr,instr(ostr, ":")-1, 2)
else
select case ostr
case "桌面"
bff = ws.specialfolders("desktop")
case "我的文档"
bff = ws.specialfolders("mydocuments")
case "我的电脑"
msgbox "无效目录！",64,"提示":wscript.quit
case "网上邻居"
msgbox "无效目录！",64,"提示":wscript.quit
case else
bff = oitem.parentfolder.parsename(oitem.title).path
end select
end if
set oshell = nothing
set oitem = nothing
if right(bff,1)<> "\" then
bff = bff & "\"
end if
on error goto 0
end function
您可能感兴趣的文章:
如您对本文有疑问或者有任何想说的，请点击进行留言回复，万千网友为您解惑！
网友评论