'-------------vbsTree.vbs------------------------
'描述:用vbs输出一个文件夹的目录结构。
' By Slore @ 2008-12-26
'------------------------------------------------

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 ShowSize
ShowSize = MsgBox("是否需要显示大小?",vbYesNo,"vbsTree By Slore") - 7

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
TreeStr = TreePath
on Error Resume Next '容错模式(忽略特殊文件夹错误)
If ShowSize Then TreeStr = TreeStr & FormatSize(objFSO.GetFolder(TreePath).Size)
TreeStr = TreeStr & vbCrLf
starttime = Timer
Tree TreePath,""
endtime = Timer
Set objFile = objFSO.CreateTextFile(OutFile,True)
objFile.Write TreeStr
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
tottime = endtime - starttime
tottime = FormatNumber(tottime,3,True) & "秒"
MsgBox "请查看当前目录下的OutTree.txt" & vbCrLf & "用时:" & tottime,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
If ShowSize Then TreeStr = TreeStr & FormatSize(ConFile.Size)
TreeStr = TreeStr & vbCrLf
Next
i = 0:TempStr = "├─"
SFSpace = FlSpace & "│"
For Each SubFolder In CrntFolder.SubFolders
i = i + 1
If i = CrntFolder.SubFolders.Count Then
TempStr = "└─"
SFSpace = FlSpace & " "
End If
TreeStr = TreeStr & FlSpace & TempStr & SubFolder.Name
If ShowSize Then TreeStr = TreeStr & FormatSize(SubFolder.size)
TreeStr = TreeStr & 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

E:\IconWorkShop (11MB)
├─axlibico.dll (383KB)
├─Axstdctl.dll (18KB)
├─Context.hlp (68KB)
├─IconWorkshop.exe (5MB)
├─Main.chm (4MB)
├─MediaFiles.axd (4KB)
├─ResChs.dll (388KB)
├─sn.txt (32字节)
├─UnInstall.exe (74KB)
├─UnInstall.ini (109字节)
├─Color Swatches (54KB)
│ ├─16 Colors (extended).axco (1KB)
│ ├─16 Colors.axco (343字节)
│ ├─Dark Hues.axco (3KB)
│ ├─Default (large).axco (6KB)
│ ├─Default (small).axco (3KB)
│ ├─Grayscale (128 levels).axco (1KB)
│ ├─Grayscale (256 levels).axco (3KB)
│ ├─IconWorkshopSwatches (3KB)
│ ├─Medium Hues.axco (3KB)
│ ├─Pastel Hues.axco (3KB)
│ ├─Photoshop Default.axco (1KB)
│ ├─Pure Hues.axco (3KB)
│ ├─Spectrum (variable lightness).axco (6KB)
│ ├─Spectrum (variable saturation).axco (6KB)
│ ├─Spectrum.axco (3KB)
│ ├─Web Safe by VisiBone.axco (3KB)
│ ├─Web Safe.axco (2KB)
│ └─Windows XP.axco (376字节)
└─Color Tables (3KB)
├─IconWorkshop Standard.axct (768字节)
├─Macintosh.axct (768字节)
├─Web Safe.axct (768字节)
├─Windows XP.axct (768字节)
└─Windows.axct (768字节)

S smile 微笑,L love 爱,O optimism 乐观,R relax 放松,E enthusiasm 热情...Slore

Originally posted by 523066680 at 2009-1-2 03:55 PM:

此乃水贴,我想到一个东西

W 微笑 A 爱 L 乐观 F 放松 R 热情
Walfr

就是没有slore华丽 :(

Originally posted by tachyon at 2010-3-28 21:09:
slore, 这个vbs在我的系统上也无法正常完成目录递归。
不过看了半天代码也没发现什么地方不对的。。。

Originally posted by kidzgy at 2010-3-28 11:14:
我希望所以文件取大小能精确到百分位。

比如
218.12MB
1.02GB
35.60KB