中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名：www.cn-dos.net 论坛域名：www.cn-dos.net/forum
DOS，代表着自由开放与发展，我们努力起来，学习FreeDOS和Linux的自由开放与GNU精神，共同创造和发展美好的自由与GNU GPL世界吧！

游客: 注册 | 登录 | 命令行 | 会员 | 搜索 | 上传 | 帮助 »

中国DOS联盟论坛 » DOS批处理 & 脚本技术（批处理室） » [原创]vbs版Tree

« [1] [2] » ›

slore
铂金会员

积分 5212
发帖 2478
注册 2007-2-8
状态离线

『楼主』: [原创]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 ]

此帖被 +36 点积分

点击查看详情

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

2008-12-26 20:23

holucan
初级用户

积分 26
发帖 25
注册 2008-11-7
状态离线

『第 2 楼』:

,哦哦，感谢分享，收下学习了，试用了一下，不错呢！

2008-12-26 21:25

oceanuse
新手上路

积分 18
发帖 15
注册 2007-3-25
状态离线

『第 3 楼』:

谢谢分享
输出一个文件夹的目录结构。
如果要是能输出磁盘根目录(如:E:\) 的目录结构就更好了
现在只能输出 E:\ 中的文件目录不能输出次级目录结构

2008-12-27 15:18

slore
铂金会员

积分 5212
发帖 2478
注册 2007-2-8
状态离线

『第 4 楼』:

测试可以输出。不过我的是NTFS的，有些文件夹权限有设置，遇到不能获取
权限的就终止了，但是能得到。

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

[ Last edited by HAT on 2009-1-2 at 21:28 ]

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

2008-12-27 16:02

523066680
银牌会员

SuperCleaner

积分 2362
发帖 1133
注册 2008-2-2
状态离线

『第 5 楼』:

Quote:

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

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

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

就是没有slore华丽

综合型编程论坛

我的作品索引

2009-1-2 15:55

(523066680)

s11ss
银牌会员

积分 2098
发帖 566
注册 2007-9-11
状态离线

『第 6 楼』:

Quote:

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

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

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

就是没有slore华丽 :(

Walfr一看就不像英文单词，哪儿有fr结尾的啊……至少我是没见过。

2009-1-2 19:46

slore
铂金会员

积分 5212
发帖 2478
注册 2007-2-8
状态离线

『第 7 楼』:

我郁闷。。。
没有编辑权限……那个没想到那么长。。。

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

呵呵，那个是先有Slore再找的意思，所以好找。

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

2009-1-2 21:13

HAT
版主

积分 9023
发帖 5017
注册 2007-5-31
状态离线

『第 8 楼』: Re 7楼

Done ^_^

2009-1-2 21:28

kioskboy
初级用户

积分 153
发帖 103
注册 2008-3-27
状态离线

『第 9 楼』:

好啊！

2009-1-3 14:09

ooaf
中级用户

积分 313
发帖 162
注册 2007-4-2
状态离线

『第 10 楼』:

在我电脑上出现问题

附件 1: 未命名.bmp (2009-1-4 23:19, 7.98 K)

2009-1-4 23:19

slore
铂金会员

积分 5212
发帖 2478
注册 2007-2-8
状态离线

『第 11 楼』:

你选的是文件夹么？

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

2009-1-5 13:42

ooaf
中级用户

积分 313
发帖 162
注册 2007-4-2
状态离线

『第 12 楼』:

“桌面”，有问题吗？

2009-1-5 21:40

slore
铂金会员

积分 5212
发帖 2478
注册 2007-2-8
状态离线

『第 13 楼』:

那个返回的是特殊文件夹标号，有别人给改过可以支持那种的，我这个原版没处理。

你在我的电脑展开选到就可以了。。。

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

2009-1-6 12:23

ouyang0349
新手上路

积分 9
发帖 9
注册 2010-3-26
状态离线

『第 14 楼』:

我这里测试只能列出部分目录，很多都无法列出来，怎么回事?

2010-3-27 09:33

ouyang0349
新手上路

积分 9
发帖 9
注册 2010-3-26
状态离线

『第 15 楼』:

我使用这个脚本列出E盘所有文件及文件夹的目录树，E盘文件很多，只能列出前四个文件夹以及目录结构，后面的都列不出来，怎么回事？

2010-3-27 10:00

« [1] [2] » ›

请注意：您目前尚未注册或登录，请您注册或登录以使用论坛的各项功能，例如发表和回复帖子等。

可打印版本 | 推荐给朋友 | 订阅主题 | 收藏主题

论坛跳转: