Board logo

标题: [原创]vbs版Tree [打印本页]
作者: slore     时间: 2008-12-26 20:23    标题: [原创]vbs版Tree

不知道当发不发。

  Quote:

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



  Quote:

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字节)

[ Last edited by slore on 2008-12-26 at 20:25 ]
作者: holucan     时间: 2008-12-26 21:25
,哦哦，感谢分享，收下学习了，试用了一下，不错呢！
作者: oceanuse     时间: 2008-12-27 15:18
谢谢分享
输出一个文件夹的目录结构。
如果要是能 输出磁盘根目录(如:E:\) 的目录结构就更好了
现在只能输出 E:\ 中的文件目录 不能输出次级目录结构
作者: slore     时间: 2008-12-27 16:02
测试可以输出。不过我的是NTFS的，有些文件夹权限有设置，遇到不能获取
权限的就终止了，但是能得到。

磁盘的话磁盘大小会得不到，因为用的是取文件夹的size不是driver的。

[ Last edited by HAT on 2009-1-2 at 21:28 ]
作者: 523066680     时间: 2009-1-2 15:55


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

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

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

就是没有slore华丽
作者: s11ss     时间: 2009-1-2 19:46


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

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

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

就是没有slore华丽 :(

Walfr一看就不像英文单词，哪儿有fr结尾的啊……至少我是没见过。
作者: slore     时间: 2009-1-2 21:13
我郁闷。。。
没有编辑权限……那个没想到那么长。。。

HAT看到了把那个 驱动器遍历的code段删除掉＝。＝

呵呵，那个是先有Slore再找的意思，所以好找。
作者: HAT     时间: 2009-1-2 21:28    标题: Re 7楼

Done ^_^
作者: kioskboy     时间: 2009-1-3 14:09
好啊！
作者: ooaf     时间: 2009-1-4 23:19
在我电脑上出现问题
附件 1: 未命名.bmp (2009-1-4 23:19, 7.98 K)


作者: slore     时间: 2009-1-5 13:42
你选的是文件夹么？
作者: ooaf     时间: 2009-1-5 21:40
“桌面”，有问题吗？
作者: slore     时间: 2009-1-6 12:23
那个返回的是特殊文件夹标号，有别人给改过可以支持那种的，我这个原版没处理。

你在我的电脑展开选到就可以了。。。
作者: ouyang0349     时间: 2010-3-27 09:33
我这里测试只能列出部分目录，很多都无法列出来，怎么回事?
作者: ouyang0349     时间: 2010-3-27 10:00
我使用这个脚本列出E盘所有文件及文件夹的目录树，E盘文件很多，只能列出前四个文件夹以及目录结构，后面的都列不出来，怎么回事？
作者: slore     时间: 2010-3-27 19:33
将
on Error Resume Next  '容错模式(忽略特殊文件夹错误)

屏蔽掉改为:
'on Error Resume Next  '容错模式(忽略特殊文件夹错误)

看下提示信息，估计是权限问题。
作者: kidzgy     时间: 2010-3-28 11:14
我希望所以文件取大小能精确到百分位。

比如
218.12MB
1.02GB
35.60KB
作者: jarry0932     时间: 2010-3-28 11:37
支持一下
作者: tachyon     时间: 2010-3-28 21:09
slore, 这个vbs在我的系统上也无法正常完成目录递归。
不过看了半天代码也没发现什么地方不对的。。。
作者: slore     时间: 2010-3-28 22:24


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

代码逻辑是正确的。。。估计是那个对象的问题，一些文件夹会莫名其妙的没有权限，尤其是系统的一些文件夹。
作者: slore     时间: 2010-3-28 22:26


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

比如
218.12MB
1.02GB
35.60KB

FormatSize函数自己改改吧。
作者: kidzgy     时间: 2010-3-29 12:49
抱歉，我对此一窍不通哦，具体怎么改哦？什么替换成什么？
作者: slore     时间: 2010-3-29 13:09
Function FormatSize(SZ)
    Dim i
    Do While SZ > 1024
        i = i + 1
        SZ = SZ / 1024
    Loop
    FormatSize = "  (" & Round(SZ,2) & Mid(Unit4Size,1 + 2 * i,2) & ")"
End Function
作者: kidzgy     时间: 2010-3-29 19:31
弄好了非常感谢哈~