【VBS】超级实用小实例:仅用数字编号打开任意指定文件夹(超超超级全面指南)
【VBS】实用链接指南
- Hello World!
- 序
- 1、目的
- 2、需求分析
- 3、举例
- 4、思路
- 一、上手编程语言初步
- (一)Visual Basic快速入门
- (二)简洁的代码编辑器推荐
- 1. Sublime Text 下载
- 2. VB代码语法高亮设置
- 3. 中文乱码或报错解决
- 二、创建最简单的窗口
- (一)教你用怎么vbs写一个简易的对话框
- (二)vbs输入框和消息框
- (三)VBS中InputBox函数的返回值使用技巧
- 三、常见问题与操作
- (一)VBS脚本一行代码太长,使用换行符
- (二)vbs执行显示中文乱码怎么办
- 四、APIs
- (一)大佬的博客
- 1. 测试开发技术—VBS随笔
- (二)字符串操作
- 1. VBS中常见字符串操作函数
- 2. vbs vbscript 中的回车换行符号 等特殊字符
- (三)数组
- (四)文件文件夹操作
- 1. VBS对文件文件夹操作的例子
- 五、产品其他完善度相关
- (一)“正规软件外形”
- 1、怎么修改桌面快捷方式图标
- 2、怎样把一般的图片变成图标格式
- 后记:小项目现状
- v1.0 纯粹面向过程编程源码
- v2.0 纯粹面向过程编码,良好函数抽象封装
- 1、架构图
- 2、源码
- v4.0 自动化获取vbs文件所在文件夹目录层次结构,代替了手动输入文件夹名称数组的硬编码(我的同事正在使用这一个比较稳定的版本)
- v4.1 在v4.0基础上,增加了夸奖人的随机形容词功能
- v5.0 增加了自动获取并显示文件夹名称结构层次的显示功能
注意:仅限Windows系统!
Hello World!
桌面新建个txt文本,打开写上如下内容:
msgbox "Hello World!"
保存,文件后缀再改为“vbs”即可执行,
(如果没有显示后缀名,自行百度解决)
双击运行,
完美的Windows系统上的迷你小窗口!
内容就是:
Hello World!
简单的要命,有木有,哈哈哈!
序
1、目的
Windows系统上用最简单的方法直接创建窗口程序,
需要有常见编程语言的语法基础。
我之前没有学过vbs,
但本身是软件工程专业科班生,
具有一定的其他多种语言的编程基础。
先有实践的问题,再想解决问题,而出现的此文章,
并不是凭空捏造的问题与文章及程序。2、需求分析
一个盘里的文件名字开头全有10以内数字编号开头,
要求弹出窗口输入一串数字编号,
便可以打开指定文件夹。
(程序是小事,
实际上如何给每个人电脑上所有文件夹合适的分类
才是根本问题!)3、举例
弹出交互窗口输入“122”,点击确认,
即可打开文件夹地址为:
“E:\工作\1、人事\2、培训\2、实习期”。
其中,后面的顿号和汉字是任意的,
只关注文件名前面的数字即可。4、思路
以需求的解决逻辑和一步步遇见的问题为思路,
去逐步百度搜索。
以下提供的所有的链接,
都是只要解决问题就可以,
几乎都不用全部浏览。有编程基础的会上手的很快。
一、上手编程语言初步
(一)Visual Basic快速入门
https://blog.csdn.net/achenyuan/article/details/83987056
如果有其他编程语言基础,这个不用看,当做语法工具书查阅即可。
(二)简洁的代码编辑器推荐
Sublime Text 3
我一开始用的Notepad++,
可惜玩了半天突然不支持VB的语法高亮了???
又问度娘搜到了这个,非常棒!
1. Sublime Text 下载
地址:https://www.sublimetext.com/
2. VB代码语法高亮设置
(后来我又找不到VB了,用ASP也行)
3. 中文乱码或报错解决
sublime text 3支持GBK编码
https://www.cnblogs.com/wxdblog/p/7992854.html
二、创建最简单的窗口
(一)教你用怎么vbs写一个简易的对话框
https://jingyan.baidu.com/article/22fe7cedd478133002617f23.html
注意: 中文可能报错或乱码,粗暴解决,用英文即可。
(二)vbs输入框和消息框
https://jingyan.baidu.com/article/9f63fb91492403c8410f0e4b.html
(三)VBS中InputBox函数的返回值使用技巧
https://www.jb51.net/article/26809.htm
三、常见问题与操作
(一)VBS脚本一行代码太长,使用换行符
http://www.51testing.com/html/85/87885-17546.html
(二)vbs执行显示中文乱码怎么办
https://jingyan.baidu.com/article/95c9d20d81c67dad4f756111.html
四、APIs
(一)大佬的博客
1. 测试开发技术—VBS随笔
https://www.cnblogs.com/jinjiangongzuoshi/category/491750.html
其中的:VBS基础篇 - 对象(1) - Class对象
用来学习面向对象形式的写法还挺不错的!!!
(二)字符串操作
1. VBS中常见字符串操作函数
https://www.jb51.net/article/159913.htm
2. vbs vbscript 中的回车换行符号 等特殊字符
https://www.dazhuanlan.com/2020/06/02/5ed645c962d9a/
(三)数组
动态数组:https://www.jb51.net/article/141114.htm
(四)文件文件夹操作
1. VBS对文件文件夹操作的例子
http://www.360doc.com/content/14/0606/15/219800_384287850.shtml
(五)vbs如何获取当前时间日期
http://www.jquerycn.cn/a_9237
五、产品其他完善度相关
将自己的vbs文件放到磁盘中合适的文件中,
然后右击发送到桌面快捷方式。
然后桌面就有快捷方式了,
它的图标是可以随意改变的,
可用其他图片,或自行设计图片。
详细步骤参考如下:
(一)“正规软件外形”
1、怎么修改桌面快捷方式图标
百度经验链接
2、怎样把一般的图片变成图标格式
推荐这个:转转大师,在线的,链接如下:
http://pdftoword.55.la/img2icon/
后记:小项目现状
v1.0 纯粹面向过程编程源码
'
' 候帅洲
'
' 手机和微信:175 3102 3301
'
' 此小项目CSDN详解博客地址:https://blog.csdn.net/weixin_44591035/article/details/113667614
'
'
'
' 1、需求分析
' 一个盘里的文件名字开头全有10以内数字编号开头,
' 要求弹出窗口输入一串数字编号,便可以打开指定文件夹。
'
' 2、举例
' 弹出交互窗口输入“122”,点击确认,
' 即可打开文件夹地址为:
' “E:\工作\1、人事\2、培训\2、实习期”。
' 其中,后面的顿号和汉字是任意的,
' 只关注文件名前面的数字即可。
'
' 3、目前进度
' 以硬编码实现了第一个实用版本(v1.0:纯粹面向过程编码)
' 已经可以投入现实使用了,一位美女同事已经用上了
' 以后逐渐慢慢迭代版本吧' 一、初始化与主窗口创建' (一)定义变量与初始化' 1. 定义和初始化目录结构
' (1)先硬编码根目录
dim strRootDir
strRootDir = "E:\工作\"' (2)先硬编码所有分目录
dim idDirArr
idDirArr = Array( _"1", "1、人事", _"2", "2、顾问", _"3", "3、个人", _"4", "4、待整理", __"11", "1、招聘", _"12", "2、培训", _"13", "3、制度", _"14", "4、活动", __"111", "1、专业知识", _"112", "2、招聘简章", _"113", "3、简历", _"114", "4、统计", _"115", "5、素材", _"116", "6、其他资料", __"120", "0、按类型分类汇总", _"121", "1、七天入职新员工培训", _"122", "2、实习期", _"123", "3、其他机构" _
)' 2. 定义和初始化各类窗口标题
dim mainWinTitle, tipsWinTitle
' (1)主窗口标题
mainWinTitle = "博瑞智(邯郸)家庭教育服务中心-孙文"
' (2)提示窗口标题
tipsWinTitle = "来自候帅洲的温馨提示"' 3. 定义和初始化各种健壮性处理提示用语
dim strTipsTemp0, strTipsTemp1, strTipsTemp2, strTipsTemp3
' (1)提示位置:一、(二)
strTipsTemp0 = vbCrLf + "世界上最漂亮的孙文!" + vbCrLf _+ vbCrLf + "请输入要打开的文件夹编号吧!"
' (2)提示位置:二、(二)
strTipsTemp1 = "您没有输入任何编号哦!!!"
' (3)提示位置:二、(三)
strTipsTemp2 = "您的输入不是纯数字哦!!!"
' (4)提示位置:三、(二)
strTipsTemp3 = "您的输入的编号没有对应的文件夹哦!!!"' (二)创建交互输入框
dim id
id = inputbox(strTipsTemp0,mainWinTitle)' 二、健壮性处理' (一)如果inputbox返回值为Empty,即用户点击的是“取消”;
If IsEmpty(id) Then WScript.Quit
End If' (二)输入框内容为空时直接点击“确定”;
If Len(id) = 0 Then msgbox strTipsTemp1, vbokcancel + vbInformation, tipsWinTitleWScript.Quit
End If' (三)id有字符但为非纯数字时
If Not isnumeric(id) Thenmsgbox strTipsTemp2, vbokcancel + vbInformation, tipsWinTitleWScript.Quit
end if' 三、主逻辑处理
' (id为纯数字时)
' (一)目录结构字典的定义和初始化
' 将目录结构“id-目录”放入键值对字典对象——idDirDict
dim idDirDict, i
Set idDirDict = WSH.CreateObject("Scripting.Dictionary")
For i = 0 to UBound(idDirArr)idDirDict.Add idDirArr(i), idDirArr(i + 1)i = i + 1
Next' (二)健壮性处理
' 判断指定的key是否存在
If Not idDirDict.Exists(id) Thenmsgbox strTipsTemp3, vbokcancel + vbInformation, tipsWinTitleWScript.Quit
End If ' (三)最终处理
' 1. 确定目录存在后,拼接绝对目录
dim strFinalDir
For i = 0 to Len(id) - 1strFinalDir = strFinalDir + "\" + idDirDict.Item(left(id, i + 1))
Next
' 2. 打开目标文件夹,结束
Dim ObjWS
Set ObjWS = WScript.CreateObject("wscript.shell")
ObjWS.run strRootDir + strFinalDir
v2.0 纯粹面向过程编码,良好函数抽象封装
1、架构图
2、源码
'
' 候帅洲
'
' 手机和微信:175 3102 3301
'
' 此小项目CSDN详解博客地址:https://blog.csdn.net/weixin_44591035/article/details/113667614
'
'
' 1、需求分析
' 一个盘里的文件名字开头全有10以内数字编号开头,
' 要求弹出窗口输入一串数字编号,便可以打开指定文件夹。
'
' 2、举例
' 弹出交互窗口输入“122”,点击确认,
' 即可打开文件夹地址为:
' “E:\工作\1、人事\2、培训\2、实习期”。
' 其中,后面的顿号和汉字是任意的,
' 只关注文件名前面的数字即可。
'
' 3、目前进度
' 以硬编码实现的第二个版本,v2
' 还是纯粹面向过程编码,但都已良好封装函数,
' 函数抽象合适,函数之间有良好简洁且固定的层次关系
' 以后逐渐慢慢迭代版本吧
' ' ' 程序入口
' ' 马克思写法,逻辑在物质中辩证存在,唯物主义辩证法
' Call MainWin()' ' 一、主窗口
' ' 主窗口总函数
' Sub MainWin()
' dim id, mainWinTitle, mainWinTips
' Call Init_MainWin(mainWinTitle, mainWinTips)
' ' 创建交互输入框
' id = inputbox(mainWinTips, mainWinTitle)
' Call Robust_MainWin(id)
' Call MainLogic(id)
' End Sub' 程序入口
' 黑格尔写法,一切都在宇宙的逻辑之中,唯心主义
Call MainLogic(MainWin())' 一、主窗口
' 主窗口总函数
Function MainWin() dim id, mainWinTitle, mainWinTipsCall Init_MainWin(mainWinTitle, mainWinTips)' 创建交互输入框id = inputbox(mainWinTips, mainWinTitle)Call Robust_MainWin(id)MainWin = id
End Function' (一)初始化主窗口提示内容
Sub Init_MainWin(mainWinTitle, mainWinTips)dim enterpriseName ,userName, userAdj, menAdj, womenAdjenterpriseName = "博瑞智(邯郸)家庭教育服务中心"userName = "孙文"menAdj = "世界上最帅的"womenAdj = "世界上最漂亮的"userAdj = womenAdj' 主窗口标题mainWinTitle = enterpriseName & "-" & userName' 提示用语mainWinTips = vbCrLf & userAdj & userName & vbCrLf _+ vbCrLf + "请输入要打开的文件夹编号吧!"
End Sub' (二)主窗口健壮性处理
Sub Robust_MainWin(id)dim tipsWinTitle, tipsWinTips1, tipsWinTips2Call Init_Robust_MainWin(tipsWinTitle, tipsWinTips1, tipsWinTips2)' 1. 如果inputbox返回值为Empty,即用户点击的是“取消”;If IsEmpty(id) Then WScript.Quit End If' 2. 输入框内容为空时直接点击“确定”;If Len(id) = 0 Then msgbox tipsWinTips1, vbokcancel + vbInformation, tipsWinTitleWScript.QuitEnd If' 3. id有字符但为非纯数字时If Not isnumeric(id) Thenmsgbox tipsWinTips2, vbokcancel + vbInformation, tipsWinTitleWScript.Quitend if
End Sub' (三)初始化主窗口健壮性处理提示窗口内容
Sub Init_Robust_MainWin(tipsWinTitle, tipsWinTips1, tipsWinTips2)' 1. 初始化主窗口健壮性处理提示窗口标题tipsWinTitle = "来自候帅洲的温馨提示"' 2. 初始化主窗口健壮性处理提示用语' (1)提示位置:一、(三)2.tipsWinTips1 = "您没有输入任何编号哦!!!" ' (2)提示位置:一、(三)3.tipsWinTips2 = "您的输入不是纯数字哦!!!"
End Sub' 二、主逻辑
' 主逻辑总函数
Sub MainLogic(id)dim strRootDir, idDirDictCall Init_MainLogic(strRootDir, idDirDict)Call Robust_MainLogic(id, idDirDict)' 1. 确定目录存在后,拼接绝对目录' (这里的确定的前提是,硬编码的目录结构映射是真实的。)dim strFinalDir, iFor i = 0 to Len(id) - 1strFinalDir = strFinalDir + "\" + idDirDict.Item(left(id, i + 1))Next' 2. 打开目标文件夹,结束Dim ObjWSSet ObjWS = WScript.CreateObject("wscript.shell")ObjWS.run strRootDir + strFinalDir
End Sub' (一)初始化主逻辑内容
Sub Init_MainLogic(strRootDir, idDirDict)' 1、硬编码目录结构' (1)先硬编码根目录strRootDir = "E:\ID之道\工作"' (2)先硬编码所有分目录dim idDirArridDirArr = Array( _"1", "1、人事", _"2", "2、顾问", _"3", "3、个人", _"4", "4、待整理", __"11", "1、招聘", _"12", "2、培训", _"13", "3、制度", _"14", "4、活动", __"111", "1、专业知识", _"112", "2、招聘简章", _"113", "3、简历", _"114", "4、统计", _"115", "5、素材", _"116", "6、其他资料", __"120", "0、按类型分类汇总", _"121", "1、七天入职新员工培训", _"122", "2、实习期", _"123", "3、其他机构" _)' (id为纯数字时)' 2、目录结构字典的初始化' 将目录结构“id-目录”放入键值对字典对象——idDirDictdim iSet idDirDict = WSH.CreateObject("Scripting.Dictionary")For i = 0 to UBound(idDirArr)idDirDict.Add idDirArr(i), idDirArr(i + 1)i = i + 1Next
End Sub' (二)主逻辑健壮性处理
Sub Robust_MainLogic(id, idDirDict)dim tipsWinTitle, tipsWinTipsCall Init_Robust_MainLogic(tipsWinTitle, tipsWinTips)' 判断指定的key是否存在If Not idDirDict.Exists(id) Thenmsgbox tipsWinTips, vbokcancel + vbInformation, tipsWinTitleWScript.QuitEnd If
End Sub' (三)初始化主逻辑健壮性处理提示窗口内容
Sub Init_Robust_MainLogic(tipsWinTitle, tipsWinTips)' 1. 初始化主逻辑健壮性处理提示窗口标题tipsWinTitle = "来自候帅洲的温馨提示"' 2. 初始化主逻辑健壮性处理提示用语tipsWinTips = "您的输入的编号没有对应的文件夹哦!!!"
End Sub
v4.0 自动化获取vbs文件所在文件夹目录层次结构,代替了手动输入文件夹名称数组的硬编码(我的同事正在使用这一个比较稳定的版本)
(汉字都抽离都了程序最前面,以便之后的封装设置选项,大家改个汉字的描述就成了属于自己的程序了)
'
' 候帅洲
'
' 手机和微信:175 3102 3301
'
' 此小项目CSDN详解博客地址:https://blog.csdn.net/weixin_44591035/article/details/113667614
'
'
' 1、需求分析
' 一个盘里的文件名字开头全有10以内数字编号开头,
' 要求弹出窗口输入一串数字编号,便可以打开指定文件夹。
'
'
' 2、举例
' 弹出交互窗口输入“122”,点击确认,
' 即可打开文件夹地址为:
' “E:\工作\1、人事\2、培训\2、实习期”。
' 其中,后面的顿号和汉字是任意的,
' 只关注文件名前面的数字即可。
'
'
' 3、目前进度
' 第四个版本,v4
' 面向对象形式改造,进一步的封装变换
' 加入自动查找抽离文件id并匹配
'' ——————————————————————————————————————————————————————————————————
'
'···························!!!注意!!!!!!
'
' 目前算法编码严格要求两个准则:
' 1、每个文件夹数字编号必须是文件名称的第一个字符并只能用一位阿拉伯数字表示
' 2、每个文件夹数字编号与文件夹名的分割符号
' 紧跟在数字后面且只有一个,且文件夹名称只能含一个
' (目前分隔符为顿号“、”,可改,但不推荐)
'
' ——————————————————————————————————————————————————————————————————dim variateValueArr
variateValueArr = Array( _"博瑞智(邯郸)家庭教育服务中心", _"孙文", _"世界上最漂亮的", _"请输入要打开的文件夹编号吧!", __"来自候帅洲的温馨提示", _"您没有输入任何编号哦!!!", _"您的输入不是纯数字哦!!!", _"您的输入的编号没有对应的文件夹哦!!!", _ _"、" _
) dim variateIDArr
variateIDArr = Array( __"111", _"112", _"113", _"114", __"211", _"212", _"213", _"221", _ _"121" _
)
dim variateDescribeArr
variateDescribeArr = Array( _"enterpriseName", _"userName", _"userAdj", _"inpuIDTips", __"tipsWinTitle", _"tipsWinTips_ClickOKWhenBlank", _"tipsWinTips_ClickOKWhenNotPureNumber", _"tipsWinTips_IDNotReal", _ _"文件夹数字编号与文件夹名的分割符号" _
)' dim classifiedNumberArr
' classifiedNumberArr = Array(4, 4, 1)dim gttwMapping
Set gttwMapping = New GTTW_Mapping
gttwMapping.variateIDArr = variateIDArr
gttwMapping.variateDescribeArr = variateDescribeArr
gttwMapping.variateValueArr = variateValueArr
gttwMapping.createMapping()' 程序入口
' 黑格尔写法,一切都在宇宙的逻辑之中,唯心主义
Call MainLogic(MainWin())' 一、主窗口
' 主窗口总函数
Function MainWin() dim id, mainWinTitle, mainWinTipsCall Init_MainWin(mainWinTitle, mainWinTips)' 创建交互输入框id = inputbox(mainWinTips, mainWinTitle)Call Robust_MainWin(id)MainWin = id
End Function' (一)初始化主窗口提示内容
Sub Init_MainWin(mainWinTitle, mainWinTips) dim enterpriseName ' variateID = 111enterpriseName = gttwMapping.getVariateValue("111")dim userNameuserName = gttwMapping.getVariateValue("112")dim userAdjuserAdj = gttwMapping.getVariateValue("113")dim inputIDTipsinputIDTips = gttwMapping.getVariateValue("114")' 1. 主窗口标题mainWinTitle = enterpriseName & "-" & userName' 2. 提示用语mainWinTips = vbCrLf & userAdj & userName & vbCrLf _+ vbCrLf + inputIDTips
End Sub' (二)主窗口健壮性处理
Sub Robust_MainWin(id)dim tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumberCall Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)' 1. 如果inputbox返回值为Empty,即用户点击的是“取消”;If IsEmpty(id) Then WScript.Quit End If' 2. 输入框内容为空时直接点击“确定”;If Len(id) = 0 Then ' msgbox tipsWinTips_ClickOKWhenBlank, vbokcancel + vbInformation, tipsWinTitleCall promptWin(tipsWinTips_ClickOKWhenBlank, tipsWinTitle)WScript.QuitEnd If' 3. id有字符但为非纯数字时If Not isnumeric(id) Then' msgbox tipsWinTips_ClickOKWhenNotPureNumber, vbokcancel + vbInformation, tipsWinTitleCall promptWin(tipsWinTips_ClickOKWhenNotPureNumber, tipsWinTitle)WScript.Quitend if
End Sub' (三)初始化主窗口健壮性处理提示窗口内容
Sub Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)' 1. 初始化主窗口健壮性处理提示窗口标题tipsWinTitle = gttwMapping.getVariateValue("211")' 2. 初始化主窗口健壮性处理提示用语' (1)提示位置:一、(三)2.tipsWinTips_ClickOKWhenBlank = gttwMapping.getVariateValue("212")' (2)提示位置:一、(三)3.tipsWinTips_ClickOKWhenNotPureNumber = gttwMapping.getVariateValue("213")
End Sub' 二、主逻辑
' 主逻辑总函数
'(id为纯数字时)
'
' 思路:
' 例如目标文件夹为:str = “E:\工作\2、222\1、开发冷战零撒扥\3、阿森简单 - 副本”
'
' 解决:
' 直接从str中抽离“213”,然后与id直接比较,一样则直接打开此文件夹' (一)定义相关变量和初始化并结束整个逻辑链sub MainLogic(id)Dim objFSO, objWS, currentDir, separatorStrSet objFSO = CreateObject("Scripting.FileSystemObject") Set objWS = WScript.CreateObject("wscript.shell")currentDir = objWS.CurrentDirectoryseparatorStr = gttwMapping.getVariateValue("121")Call SearchFolder(currentDir, objFSO, objWS, id, separatorStr)dim tipsWinTitletipsWinTitle = gttwMapping.getVariateValue("211")dim tipsWinTips_IDNotRealtipsWinTips_IDNotReal = gttwMapping.getVariateValue("221")' msgbox tipsWinTips_IDNotReal, vbokcancel + vbInformation, tipsWinTitleCall promptWin(tipsWinTips_IDNotReal, tipsWinTitle)
end sub' (二)核心算法函数封装
Sub SearchFolder(folderPath, objFSO, objWS, id, separatorStr) dim objFolderSet objFolder=objFSO.GetFolder(folderPath)Set SubFolders=objFolder.SubFoldersIf SubFolders.Count = 0 then'msgbox "exit search:" & folderPathexit SubEnd Ifdim strIDTemp, ss, n, str, index, strTempFor Each subFolder In SubFoldersstrIDTemp = subFolder.path ss = Split(strIDTemp, separatorStr, -1)n = UBound(ss) - 1str = ""For i = 0 to nstrTemp = ss(i)index = Len(strTemp)str = str & Mid(strTemp, index, 1)nextif StrComp(str, id) = 0 then' msgbox strIDTempCall openDir(strIDTemp, objWS)WScript.Quitend ifCall SearchFolder(subFolder.path, objFSO, objWS, id, separatorStr)Next
End Sub' 提示窗口
Sub promptWin(tips, title)msgbox tips, vbokcancel + vbInformation, title
End Sub' 打开文件夹,这里主要是解决了路径带空格报错的问题
Sub openDir(dir, objWS)Const vbQuote = """"dir = vbQuote & dir & vbQuoteobjWS.run dir
End Sub' GTTW制作的Mapping核心映射类
' 以程序设计的标准化、规范化、流程化为中心思想
' 最重要的是合适的抽象化
'
' 此映射类给程序提供模板化设计思想
'
' 此映射类主要功能:
' 映射所有与现实世界有关的变量
' 让程序设计依赖抽象,而不去依赖具体现实,符合依赖倒置原则
' 并提供可视化设置的数据接口
'
' 感觉完全可以存到数据库呀!
' Class GTTW_Mapping' Key Value Dictionary Variate' IDValueDictVar' IVDV —> ivdv' (variateIDArr --> variateValueArr)' “ID-值”键值对字典映射变量Private m_ivdv' IDDescribeDictVar' IDDV —> iddv' (variateIDArr --> variateValueArr)' “ID-描述”键值对字典映射变量Private m_iddv Private m_variateIDArr ' 需要主体程序设计的形而上变量的id数组Private m_variateValueArr ' 需要从现实世界获取的变量的值数组Private m_variateDescribeArr ' 需要主体程序设计的形而上变量的描述数组Private m_classifiedNumberArr ' 需要主体程序传入的以上变量数组的分类分组数目数组' Initialize事件相当于构造函数Private Sub Class_Initialize ' 当这个类被创建时执行' MsgBox "类开始"Set m_ivdv = WSH.CreateObject("Scripting.Dictionary")Set m_iddv = WSH.CreateObject("Scripting.Dictionary")End SubPublic Default Function Constructor(variateIDArr, variateDescribeArr, classifiedNumberArr)m_variateIDArr = variateIDArrm_variateDescribeArr = variateDescribeArrm_classifiedNumberArr = classifiedNumberArr' Set Constructor = MeEnd Function' 只读只写方法Public Property Get ivdvivdv = m_ivdvEnd Property' 注意————私有的Private Property Let ivdv(new_ivdv)m_ivdv = new_ivdvEnd Property Public Property Get iddviddv = m_iddvEnd Property' 注意————私有的Private Property Let iddv(new_iddv)m_iddv = new_iddvEnd Property Public Property Get variateIDArrvariateIDArr = m_variateIDArrEnd Property Public Property Let variateIDArr(new_variateIDArr)m_variateIDArr = new_variateIDArrEnd Property Public Property Get variateValueArrvariateValueArr = m_variateValueArrEnd Property ' 注意————之后要改为私有的Public Property Let variateValueArr(new_variateValueArr)m_variateValueArr = new_variateValueArrEnd Property Public Property Get variateDescribeArrvariateDescribeArr = m_variateDescribeArrEnd Property Public Property Let variateDescribeArr(new_variateDescribeArr)m_variateDescribeArr = new_variateDescribeArrEnd Property Public Property Get classifiedNumberArrclassifiedNumberArr = m_classifiedNumberArrEnd Property Public Property Let classifiedNumberArr(new_classifiedNumberArr)m_classifiedNumberArr = new_classifiedNumberArrEnd Property ' 建立两个映射Public Sub createMapping()dim i, nn = ubound(m_variateIDArr)For i = 0 to nm_ivdv.Add m_variateIDArr(i), m_variateValueArr(i)Next For i = 0 to nm_iddv.Add m_variateIDArr(i), m_variateDescribeArr(i)Next End Sub ' 以变量id得到相应变量在现实世界的值Public Function getVariateValue(variateID)getVariateValue = m_ivdv.Item(variateID)End Function' 以变量id得到相应变量在现实世界的描述Public Function getVariateDescribe(variateID)getVariateDescribe = m_iddv.Item(variateID)End Function
End Class
v4.1 在v4.0基础上,增加了夸奖人的随机形容词功能
(不过,目前形容词库还是硬编码)
'
' 候帅洲
'
' 手机和微信:175 3102 3301
'
' 此小项目CSDN详解博客地址:https://blog.csdn.net/weixin_44591035/article/details/113667614
'
'
' 1、需求分析
' 一个盘里的文件名字开头全有10以内数字编号开头,
' 要求弹出窗口输入一串数字编号,便可以打开指定文件夹。
'
'
' 2、举例
' 弹出交互窗口输入“122”,点击确认,
' 即可打开文件夹地址为:
' “E:\工作\1、人事\2、培训\2、实习期”。
' 其中,后面的顿号和汉字是任意的,
' 只关注文件名前面的数字即可。
'
'
' 3、目前进度
' 第四个版本,v4
' 面向对象形式改造,进一步的封装变换
' 加入自动查找抽离文件id并匹配
' 增加了夸奖人的随机形容词功能
'' ——————————————————————————————————————————————————————————————————
'
'···························!!!注意!!!!!!
'
' 目前算法编码严格要求两个准则:
' 1、每个文件夹数字编号必须是文件名称的第一个字符并只能用一位阿拉伯数字表示
' 2、每个文件夹数字编号与文件夹名的分割符号
' 紧跟在数字后面且只有一个,且文件夹名称只能含一个
' (目前分隔符为顿号“、”,可改,但不推荐)
'
' ——————————————————————————————————————————————————————————————————dim variateValueArr
variateValueArr = Array( _"博瑞智(邯郸)家庭教育服务中心", _"孙文", _"请输入要打开的文件夹编号吧!", __"来自候帅洲的温馨提示", _"您没有输入任何编号哦!!!", _"您的输入不是纯数字哦!!!", _"您的输入的编号没有对应的文件夹哦!!!", _ _"、" _
) dim variateIDArr
variateIDArr = Array( __"111", _"112", _"114", __"211", _"212", _"213", _"221", _ _"121" _
)
dim variateDescribeArr
variateDescribeArr = Array( _"enterpriseName", _"userName", _"inpuIDTips", __"tipsWinTitle", _"tipsWinTips_ClickOKWhenBlank", _"tipsWinTips_ClickOKWhenNotPureNumber", _"tipsWinTips_IDNotReal", _ _"文件夹数字编号与文件夹名的分割符号" _
)' dim classifiedNumberArr
' classifiedNumberArr = Array(4, 4, 1)dim gttwMapping
Set gttwMapping = New GTTW_Mapping
gttwMapping.variateIDArr = variateIDArr
gttwMapping.variateDescribeArr = variateDescribeArr
gttwMapping.variateValueArr = variateValueArr
gttwMapping.createMapping()' 程序入口
' 黑格尔写法,一切都在宇宙的逻辑之中,唯心主义
Call MainLogic(MainWin())' 一、主窗口
' 主窗口总函数
Function MainWin() dim id, mainWinTitle, mainWinTipsCall Init_MainWin(mainWinTitle, mainWinTips)' 创建交互输入框id = inputbox(mainWinTips, mainWinTitle)Call Robust_MainWin(id)MainWin = id
End Function' (一)初始化主窗口提示内容
Sub Init_MainWin(mainWinTitle, mainWinTips) dim enterpriseName ' variateID = 111enterpriseName = gttwMapping.getVariateValue("111")dim userNameuserName = gttwMapping.getVariateValue("112")dim userAdjuserAdj = praiseWords() + "的"dim inputIDTipsinputIDTips = gttwMapping.getVariateValue("114")' 1. 主窗口标题mainWinTitle = enterpriseName & "-" & userName' 2. 提示用语mainWinTips = vbCrLf & userAdj & userName & vbCrLf _+ vbCrLf + inputIDTips
End Sub' (二)主窗口健壮性处理
Sub Robust_MainWin(id)dim tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumberCall Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)' 1. 如果inputbox返回值为Empty,即用户点击的是“取消”;If IsEmpty(id) Then WScript.Quit End If' 2. 输入框内容为空时直接点击“确定”;If Len(id) = 0 Then ' msgbox tipsWinTips_ClickOKWhenBlank, vbokcancel + vbInformation, tipsWinTitleCall promptWin(tipsWinTips_ClickOKWhenBlank, tipsWinTitle)WScript.QuitEnd If' 3. id有字符但为非纯数字时If Not isnumeric(id) Then' msgbox tipsWinTips_ClickOKWhenNotPureNumber, vbokcancel + vbInformation, tipsWinTitleCall promptWin(tipsWinTips_ClickOKWhenNotPureNumber, tipsWinTitle)WScript.Quitend if
End Sub' (三)初始化主窗口健壮性处理提示窗口内容
Sub Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)' 1. 初始化主窗口健壮性处理提示窗口标题tipsWinTitle = gttwMapping.getVariateValue("211")' 2. 初始化主窗口健壮性处理提示用语' (1)提示位置:一、(三)2.tipsWinTips_ClickOKWhenBlank = gttwMapping.getVariateValue("212")' (2)提示位置:一、(三)3.tipsWinTips_ClickOKWhenNotPureNumber = gttwMapping.getVariateValue("213")
End Sub' 二、主逻辑
' 主逻辑总函数
'(id为纯数字时)
'
' 思路:
' 例如目标文件夹为:str = “E:\工作\2、222\1、开发冷战零撒扥\3、阿森简单 - 副本”
'
' 解决:
' 直接从str中抽离“213”,然后与id直接比较,一样则直接打开此文件夹' (一)定义相关变量和初始化并结束整个逻辑链sub MainLogic(id)Dim objFSO, objWS, currentDir, separatorStrSet objFSO = CreateObject("Scripting.FileSystemObject") Set objWS = WScript.CreateObject("wscript.shell")currentDir = objWS.CurrentDirectoryseparatorStr = gttwMapping.getVariateValue("121")Call SearchFolder(currentDir, objFSO, objWS, id, separatorStr)dim tipsWinTitletipsWinTitle = gttwMapping.getVariateValue("211")dim tipsWinTips_IDNotRealtipsWinTips_IDNotReal = gttwMapping.getVariateValue("221")' msgbox tipsWinTips_IDNotReal, vbokcancel + vbInformation, tipsWinTitleCall promptWin(tipsWinTips_IDNotReal, tipsWinTitle)
end sub' (二)核心算法函数封装
Sub SearchFolder(folderPath, objFSO, objWS, id, separatorStr) dim objFolderSet objFolder=objFSO.GetFolder(folderPath)Set SubFolders=objFolder.SubFoldersIf SubFolders.Count = 0 then'msgbox "exit search:" & folderPathexit SubEnd Ifdim strIDTemp, ss, n, str, index, strTempFor Each subFolder In SubFoldersstrIDTemp = subFolder.path ss = Split(strIDTemp, separatorStr, -1)n = UBound(ss) - 1str = ""For i = 0 to nstrTemp = ss(i)index = Len(strTemp)str = str & Mid(strTemp, index, 1)nextif StrComp(str, id) = 0 then' msgbox strIDTempCall openDir(strIDTemp, objWS)WScript.Quitend ifCall SearchFolder(subFolder.path, objFSO, objWS, id, separatorStr)Next
End Sub' 提示窗口
Sub promptWin(tips, title)msgbox tips, vbokcancel + vbInformation, title
End Sub' 打开文件夹,这里主要是解决了路径带空格报错的问题
Sub openDir(dir, objWS)Const vbQuote = """"dir = vbQuote & dir & vbQuoteobjWS.run dir
End Sub' GTTW制作的Mapping核心映射类
' 以程序设计的标准化、规范化、流程化为中心思想
' 最重要的是合适的抽象化
'
' 此映射类给程序提供模板化设计思想
'
' 此映射类主要功能:
' 映射所有与现实世界有关的变量
' 让程序设计依赖抽象,而不去依赖具体现实,符合依赖倒置原则
' 并提供可视化设置的数据接口
'
' 感觉完全可以存到数据库呀!
' Class GTTW_Mapping' Key Value Dictionary Variate' IDValueDictVar' IVDV —> ivdv' (variateIDArr --> variateValueArr)' “ID-值”键值对字典映射变量Private m_ivdv' IDDescribeDictVar' IDDV —> iddv' (variateIDArr --> variateValueArr)' “ID-描述”键值对字典映射变量Private m_iddv Private m_variateIDArr ' 需要主体程序设计的形而上变量的id数组Private m_variateValueArr ' 需要从现实世界获取的变量的值数组Private m_variateDescribeArr ' 需要主体程序设计的形而上变量的描述数组Private m_classifiedNumberArr ' 需要主体程序传入的以上变量数组的分类分组数目数组' Initialize事件相当于构造函数Private Sub Class_Initialize ' 当这个类被创建时执行' MsgBox "类开始"Set m_ivdv = WSH.CreateObject("Scripting.Dictionary")Set m_iddv = WSH.CreateObject("Scripting.Dictionary")End SubPublic Default Function Constructor(variateIDArr, variateDescribeArr, classifiedNumberArr)m_variateIDArr = variateIDArrm_variateDescribeArr = variateDescribeArrm_classifiedNumberArr = classifiedNumberArr' Set Constructor = MeEnd Function' 只读只写方法Public Property Get ivdvivdv = m_ivdvEnd Property' 注意————私有的Private Property Let ivdv(new_ivdv)m_ivdv = new_ivdvEnd Property Public Property Get iddviddv = m_iddvEnd Property' 注意————私有的Private Property Let iddv(new_iddv)m_iddv = new_iddvEnd Property Public Property Get variateIDArrvariateIDArr = m_variateIDArrEnd Property Public Property Let variateIDArr(new_variateIDArr)m_variateIDArr = new_variateIDArrEnd Property Public Property Get variateValueArrvariateValueArr = m_variateValueArrEnd Property ' 注意————之后要改为私有的Public Property Let variateValueArr(new_variateValueArr)m_variateValueArr = new_variateValueArrEnd Property Public Property Get variateDescribeArrvariateDescribeArr = m_variateDescribeArrEnd Property Public Property Let variateDescribeArr(new_variateDescribeArr)m_variateDescribeArr = new_variateDescribeArrEnd Property Public Property Get classifiedNumberArrclassifiedNumberArr = m_classifiedNumberArrEnd Property Public Property Let classifiedNumberArr(new_classifiedNumberArr)m_classifiedNumberArr = new_classifiedNumberArrEnd Property ' 建立两个映射Public Sub createMapping()dim i, nn = ubound(m_variateIDArr)For i = 0 to nm_ivdv.Add m_variateIDArr(i), m_variateValueArr(i)Next For i = 0 to nm_iddv.Add m_variateIDArr(i), m_variateDescribeArr(i)Next End Sub ' 以变量id得到相应变量在现实世界的值Public Function getVariateValue(variateID)getVariateValue = m_ivdv.Item(variateID)End Function' 以变量id得到相应变量在现实世界的描述Public Function getVariateDescribe(variateID)getVariateDescribe = m_iddv.Item(variateID)End Function
End ClassFunction praiseWords()dim strstr = "独立 大方 爱美 善于交际 另类 有耐力 温柔 体贴 有见识 有仪态 撒娇 任性 美丽 善良 大方 优雅 文静 " & _"活泼 率直 可爱 天真 端庄 温柔 贤惠 多才 俊俏 国色天香 倾国倾城 美艳绝世 清丽绝俗 天生丽质 开朗 贤淑 纯洁 " & _"回眸一笑百媚生 沉鱼落雁 闭月羞花 貌赛西施 风华绝代 仪态万端 婉风流转 美撼凡尘 聘婷秀雅 娥娜翩跹 俏丽多姿 " & _"风姿卓越 顾盼流转 清丝纠缠 举步轻摇 明艳不可方物 闭月羞花 沉鱼落雁 倾国倾城 温婉娴淑 千娇百媚 仪态万千 " & _ "美若天仙 美愈天人 不施粉黛天然美 清秀高雅 姿容绝代 玉指如葱 肤如凝脂 眉如新月 秋波流转 樱桃小口 美人微笑转星眸 " & _"国色天香 花容月貌 明目皓齿 淡扫峨眉 清艳脱俗 香肌玉肤 艳冠群芳 剪水双瞳 美艳绝伦 神仙玉骨 楚楚动人 脱俗 " & _"如花似玉 倾国倾城 静若处子 动若脱兔 螓首蛾眉 淡妆浓抹 双瞳剪水 貌美如花 姿容绝代 玉指如葱 肤如凝脂 清秀高雅 " & _"绝代佳人 仙姿佚貌 冰肌玉骨 眉目如画 环肥燕瘦 眉清目秀 千娇百媚 梨花带雨 清艳脱俗 妖娆动人 艳光四射 淡扫峨眉 " & _"仪态万端 婉风流转 美撼凡尘 聘婷秀雅 娇小玲珑 小家碧玉 粉装玉琢 夭桃秾李 美如冠玉 红飞翠舞 齿白唇红 绰约多姿 " & _"美若天仙 美愈天人 貌赛西施 美艳绝世 娥娜翩跹 俏丽多姿 艳冠群芳 剪水双瞳 秋波流转 樱桃小口 空谷幽兰 眉如新月 " & _"清丽脱俗 花容月貌 明眸皓齿 天生丽质 亭亭玉立 如花似玉 花枝招展 出水芙蓉 宛转蛾眉 靡颜腻理 粉妆玉琢 月里嫦娥 " & _"国色天姿 玉貌花容 秀外惠中 仙姿玉貌 美艳绝伦 神仙玉骨 楚楚动人 顾盼流转 唇红齿白 风情万众 顾盼生姿 明眸善睐 " & _"齿如编贝 目若朗星 明眸皓齿 恍若天人 沉鱼落雁 倾国倾城 国色天香 闭月羞花"dim strArrstrArr = split(str, " ")n = UBound(strArr)ran = GetRandomInt(1, n)praiseWords = strArr(ran)
End FunctionFunction GetRandomInt(m,n)dim ranran = Second(Now) * 3While ran > n Or ran < mIf ran > n Thenran = ran - day(Now)End IfIf ran < m Thenran = ran + Second(Now)End IfWendGetRandomInt = ran
End Function
v5.0 增加了自动获取并显示文件夹名称结构层次的显示功能
(但问题是,1,显示窗口是独立的,多了一步,麻烦了。2,如果文件夹太多,显示不全,此情况待解决。
应该上工程了。
)
'
' 候帅洲
'
' 手机和微信:175 3102 3301
'
' 此小项目CSDN详解博客地址:https://blog.csdn.net/weixin_44591035/article/details/113667614
'
'
' 1、需求分析
' 一个盘里的文件名字开头全有10以内数字编号开头,
' 要求弹出窗口输入一串数字编号,便可以打开指定文件夹。
'
'
' 2、举例
' 弹出交互窗口输入“122”,点击确认,
' 即可打开文件夹地址为:
' “E:\工作\1、人事\2、培训\2、实习期”。
' 其中,后面的顿号和汉字是任意的,
' 只关注文件名前面的数字即可。
'
'
' 3、目前进度
' 第五个版本,v5
' 增加窗口显示目录结构和对应编号
'' ——————————————————————————————————————————————————————————————————
'
'···························!!!注意!!!!!!
'
' 目前算法编码严格要求两个准则:
' 1、每个文件夹数字编号必须是文件名称的第一个字符并只能用一位阿拉伯数字表示
' 2、每个文件夹数字编号与文件夹名的分割符号,
' 紧跟在数字后面并只有一个,且文件夹名称只能含一个
' (目前分隔符为顿号“、”,可改,但不推荐)
'
' ——————————————————————————————————————————————————————————————————dim variateValueArr
variateValueArr = Array( __"您想打开那个文件夹呢?" & vbCrLf & "请稍微记一下要打开的文件夹后面对应的编号吧!" & vbCrLf , __"博瑞智(邯郸)家庭教育服务中心", _"文文姐", _vbCrLf & "现在," & vbCrLf & vbCrLf & "请输入要打开的文件夹编号吧!", __"候帅洲说:", _"没有输入任何编号哦!!!", _"输入的不是纯数字哦!!!", _"输入的编号没有对应的文件夹哦!!!", _ _"、", _"6", _"4" _
) dim variateIDArr
variateIDArr = Array( __"110", __"111", _"112", _"114", __"211", _"212", _"213", _"221", _ _"121", _ "122", _ "123" _
)' 变量id(变量名称):该变量描述。
dim variateDescribeArr
variateDescribeArr = Array( _"110(tipsTitle):展示文件树的首窗口提示用语。", __"111(enterpriseName):企业名称(个人当然也可以用了,一个人对待自己电脑里的资源就要像对待自己的公司一样)。", _"112(userName):用户名称。", "113(userAdj):用户的描述,狠劲夸即可。", _"114(inpuIDTips):输入ID时的提示用语,要礼貌,也狠劲夸即可。", __"211(tipsWinTitle):提示窗口的边框上标题。", _"212(tipsWinTips_ClickOKWhenBlank):文本输入框没有内容就点击了确认的提示用语。", _"213(tipsWinTips_ClickOKWhenNotPureNumber):文本框输入的内容不是纯数字时的提示用语。", _"221(tipsWinTips_IDNotReal):文本框输入的纯数字没有对应真实存在的文件夹ID编号。", _ _"232(separatorStr):文件夹数字编号与文件夹名的分割符号。", _"122(levelIndentSpaceNumber):文件夹树型结构展示窗口中文件夹名称前面的缩进空格数量", _"123(numberIndentSpaceNumber):文件夹树型结构展示窗口中文件夹名称和后面自动生成编号直接的空间隙的空格数量(目前的设计为纯空格)。" _
)' dim classifiedNumberArr
' classifiedNumberArr = Array(4, 4, 1)dim gttwMapping
Set gttwMapping = New GTTW_Mapping
gttwMapping.variateIDArr = variateIDArr
gttwMapping.variateDescribeArr = variateDescribeArr
gttwMapping.variateValueArr = variateValueArr
gttwMapping.createMapping()Dim objFSO, objWS
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWS = WScript.CreateObject("wscript.shell")dim currentDir
currentDir = objWS.CurrentDirectoryDim filesTree' 程序入口
' 黑格尔写法,一切都在宇宙的逻辑之中,唯心主义
Call MainLogic(MainWin())' 一、主窗口
' 主窗口总函数
Function MainWin() dim separatorStrseparatorStr = gttwMapping.getVariateValue("121")Call showFolderStructure(currentDir, separatorStr)dim tipsWinTitletipsWinTitle = gttwMapping.getVariateValue("211")Call showFolderStructureWin(filesTree, tipsWinTitle) dim id, mainWinTitle, mainWinTipsCall Init_MainWin(mainWinTitle, mainWinTips)' 创建交互输入框id = inputbox(mainWinTips, mainWinTitle)Call Robust_MainWin(id)MainWin = id
End Function' (一)初始化主窗口提示内容
Sub Init_MainWin(mainWinTitle, mainWinTips) ' 1. 主窗口标题mainWinTitle = gttwMapping.getVariateValue("211")' 2. 提示用语mainWinTips = gttwMapping.getVariateValue("114")
End Sub' (二)主窗口健壮性处理
Sub Robust_MainWin(id)dim tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumberCall Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)' 1. 如果inputbox返回值为Empty,即用户点击的是“取消”;If IsEmpty(id) Then WScript.Quit End If' 2. 输入框内容为空时直接点击“确定”;If Len(id) = 0 Then ' msgbox tipsWinTips_ClickOKWhenBlank, vbokcancel + vbInformation, tipsWinTitleCall promptWin(tipsWinTips_ClickOKWhenBlank, tipsWinTitle)WScript.QuitEnd If' 3. id有字符但为非纯数字时If Not isnumeric(id) Then' msgbox tipsWinTips_ClickOKWhenNotPureNumber, vbokcancel + vbInformation, tipsWinTitleCall promptWin(tipsWinTips_ClickOKWhenNotPureNumber, tipsWinTitle)WScript.Quitend if
End Sub' (三)初始化主窗口健壮性处理提示窗口内容
Sub Init_Robust_MainWin(tipsWinTitle, tipsWinTips_ClickOKWhenBlank, tipsWinTips_ClickOKWhenNotPureNumber)' 1. 初始化主窗口健壮性处理提示窗口标题tipsWinTitle = gttwMapping.getVariateValue("211")' 2. 初始化主窗口健壮性处理提示用语' (1)提示位置:一、(三)2.tipsWinTips_ClickOKWhenBlank = gttwMapping.getVariateValue("212")' (2)提示位置:一、(三)3.tipsWinTips_ClickOKWhenNotPureNumber = gttwMapping.getVariateValue("213")
End Sub' 二、主逻辑
' 主逻辑总函数
'(id为纯数字时)
'
' 思路:
' 例如目标文件夹为:str = “E:\工作\2、222\1、开发冷战零撒扥\3、阿森简单 - 副本”
'
' 解决:
' 直接从str中抽离“213”,然后与id直接比较,一样则直接打开此文件夹' (一)定义相关变量和初始化并结束整个逻辑链sub MainLogic(id)' Dim objFSO, objWS' dim currentDir' Set objFSO = CreateObject("Scripting.FileSystemObject") ' Set objWS = WScript.CreateObject("wscript.shell")' currentDir = objWS.CurrentDirectorydim separatorStrseparatorStr = gttwMapping.getVariateValue("121")Call SearchFolder(currentDir, id, separatorStr)dim tipsWinTitletipsWinTitle = gttwMapping.getVariateValue("211")dim tipsWinTips_IDNotRealtipsWinTips_IDNotReal = gttwMapping.getVariateValue("221")' msgbox tipsWinTips_IDNotReal, vbokcancel + vbInformation, tipsWinTitleCall promptWin(tipsWinTips_IDNotReal, tipsWinTitle)
end sub' (二)核心算法函数封装
' 1. id匹配文件夹
Sub SearchFolder(folderPath, id, separatorStr) dim objFolderSet objFolder=objFSO.GetFolder(folderPath)Set SubFolders=objFolder.SubFoldersIf SubFolders.Count = 0 then'msgbox "exit search:" & folderPathexit SubEnd Ifdim strIDTemp, strFor Each subFolder In SubFoldersstrIDTemp = subFolder.path str = splitJointNumber_Func(strIDTemp, separatorStr)if StrComp(str, id) = 0 then' msgbox strIDTempCall openDir(strIDTemp, objWS)WScript.Quitend ifCall SearchFolder(subFolder.path, id, separatorStr)Next
End Sub' 2. 文件夹清晰结构展示
Sub showFolderStructure(folderPath, separatorStr) Set objFolder=objFSO.GetFolder(folderPath)Set SubFolders=objFolder.SubFoldersIf SubFolders.Count = 0 then'msgbox "exit search:" & folderPathexit SubEnd IfFor Each subFolder In SubFolderss = subFolder.pathCall showFolderNameByLevelSpace(s, separatorStr)Call showFolderStructure(s, separatorStr)NextEnd Sub' 文件夹清晰结构展示算法核心
Sub showFolderNameByLevelSpace(fullPath, separatorStr)dim index, fullFolderName, folderNamedim ss, n, splitJointNumberdim initialChar, secondChardim levelIndentStr,levelIndentSpaceNumberdim numberIndentStr, numberIndentSpaceNumberlevelIndentSpaceNumber = gttwMapping.getVariateValue("122")numberIndentSpaceNumber = gttwMapping.getVariateValue("123")index = InstrRev(fullPath, "\") + 1fullFolderName = Mid(fullPath, index)folderName = Mid(fullFolderName, 3)ss = Split(fullPath, separatorStr, -1)n = UBound(ss)initialChar = Asc(fullFolderName)secondChar = Mid(fullFolderName, 2, 1)levelIndentStr = Space(levelIndentSpaceNumber * n)numberIndentStr = Space(numberIndentSpaceNumber)splitJointNumber = splitJointNumber_Func(fullPath, separatorStr) If initialChar >= Asc("0") _And initialChar <= Asc("9") _And StrComp(secondChar, separatorStr) = 0 ThenIf Len(splitJointNumber) = 1 ThenfilesTree = filesTree & vbCrLf & vbCrLfEnd IffilesTree = filesTree & levelIndentStr _& folderName _& numberIndentStr _& splitJointNumber _& vbCrLf' & "→"End IfEnd Sub' 从绝对路径抽离文件夹全编号
Function splitJointNumber_Func(fullPath, separatorStr)dim ss, n, str, index, strTempss = Split(fullPath, separatorStr, -1)n = UBound(ss) - 1str = ""For i = 0 to nstrTemp = ss(i)index = Len(strTemp)str = str & Mid(strTemp, index, 1)nextsplitJointNumber_Func = str
End Function' 文件夹树型结构展示窗口
Sub showFolderStructureWin(tipsContent, title)dim userNameuserName = gttwMapping.getVariateValue("112")dim userAdjuserAdj = praiseWords() + "的"dim tipsTitletipsTitle = userAdj & userName & "! " & gttwMapping.getVariateValue("110")tips = tipsTitle & tipsContentmsgbox tips, vbQuestion, title
End Sub' 提示窗口
Sub promptWin(tips, title)dim userNameuserName = gttwMapping.getVariateValue("112")tips = userAdj & userName & tipsmsgbox tips, vbokcancel + vbInformation, title
End Sub' 打开文件夹,这里主要是解决了路径带空格报错的问题
Sub openDir(dir, objWS)Const vbQuote = """"dir = vbQuote & dir & vbQuoteobjWS.run dir
End Sub' GTTW制作的Mapping核心映射类
' 以程序设计的标准化、规范化、流程化为中心思想
' 最重要的是合适的抽象化
'
' 此映射类给程序提供模板化设计思想
'
' 此映射类主要功能:
' 映射所有与现实世界有关的变量
' 让程序设计依赖抽象,而不去依赖具体现实,符合依赖倒置原则
' 并提供可视化设置的数据接口
'
' 感觉完全可以存到数据库呀!
' Class GTTW_Mapping' Key Value Dictionary Variate' IDValueDictVar' IVDV —> ivdv' (variateIDArr --> variateValueArr)' “ID-值”键值对字典映射变量Private m_ivdv' IDDescribeDictVar' IDDV —> iddv' (variateIDArr --> variateValueArr)' “ID-描述”键值对字典映射变量Private m_iddv Private m_variateIDArr ' 需要主体程序设计的形而上变量的id数组Private m_variateValueArr ' 需要从现实世界获取的变量的值数组Private m_variateDescribeArr ' 需要主体程序设计的形而上变量的描述数组Private m_classifiedNumberArr ' 需要主体程序传入的以上变量数组的分类分组数目数组' Initialize事件相当于构造函数Private Sub Class_Initialize ' 当这个类被创建时执行' MsgBox "类开始"Set m_ivdv = WSH.CreateObject("Scripting.Dictionary")Set m_iddv = WSH.CreateObject("Scripting.Dictionary")End SubPublic Default Function Constructor(variateIDArr, variateDescribeArr, classifiedNumberArr)m_variateIDArr = variateIDArrm_variateDescribeArr = variateDescribeArrm_classifiedNumberArr = classifiedNumberArr' Set Constructor = MeEnd Function' 只读只写方法Public Property Get ivdvivdv = m_ivdvEnd Property' 注意————私有的Private Property Let ivdv(new_ivdv)m_ivdv = new_ivdvEnd Property Public Property Get iddviddv = m_iddvEnd Property' 注意————私有的Private Property Let iddv(new_iddv)m_iddv = new_iddvEnd Property Public Property Get variateIDArrvariateIDArr = m_variateIDArrEnd Property Public Property Let variateIDArr(new_variateIDArr)m_variateIDArr = new_variateIDArrEnd Property Public Property Get variateValueArrvariateValueArr = m_variateValueArrEnd Property ' 注意————之后要改为私有的Public Property Let variateValueArr(new_variateValueArr)m_variateValueArr = new_variateValueArrEnd Property Public Property Get variateDescribeArrvariateDescribeArr = m_variateDescribeArrEnd Property Public Property Let variateDescribeArr(new_variateDescribeArr)m_variateDescribeArr = new_variateDescribeArrEnd Property Public Property Get classifiedNumberArrclassifiedNumberArr = m_classifiedNumberArrEnd Property Public Property Let classifiedNumberArr(new_classifiedNumberArr)m_classifiedNumberArr = new_classifiedNumberArrEnd Property ' 建立两个映射Public Sub createMapping()dim i, nn = ubound(m_variateIDArr)For i = 0 to nm_ivdv.Add m_variateIDArr(i), m_variateValueArr(i)Next For i = 0 to nm_iddv.Add m_variateIDArr(i), m_variateDescribeArr(i)Next End Sub ' 以变量id得到相应变量在现实世界的值Public Function getVariateValue(variateID)getVariateValue = m_ivdv.Item(variateID)End Function' 以变量id得到相应变量在现实世界的描述Public Function getVariateDescribe(variateID)getVariateDescribe = m_iddv.Item(variateID)End Function
End ClassFunction praiseWords()dim strstr = "独立 大方 爱美 善于交际 另类 有耐力 温柔 体贴 有见识 有仪态 撒娇 任性 美丽 善良 大方 优雅 文静 " & _"活泼 率直 可爱 天真 端庄 温柔 贤惠 多才 俊俏 国色天香 倾国倾城 美艳绝世 清丽绝俗 天生丽质 开朗 贤淑 纯洁 " & _"回眸一笑百媚生 沉鱼落雁 闭月羞花 貌赛西施 风华绝代 仪态万端 婉风流转 美撼凡尘 聘婷秀雅 娥娜翩跹 俏丽多姿 " & _"风姿卓越 顾盼流转 清丝纠缠 举步轻摇 明艳不可方物 闭月羞花 沉鱼落雁 倾国倾城 温婉娴淑 千娇百媚 仪态万千 " & _ "美若天仙 美愈天人 不施粉黛天然美 清秀高雅 姿容绝代 玉指如葱 肤如凝脂 眉如新月 秋波流转 樱桃小口 美人微笑转星眸 " & _"国色天香 花容月貌 明目皓齿 淡扫峨眉 清艳脱俗 香肌玉肤 艳冠群芳 剪水双瞳 美艳绝伦 神仙玉骨 楚楚动人 脱俗 " & _"如花似玉 倾国倾城 静若处子 动若脱兔 螓首蛾眉 淡妆浓抹 双瞳剪水 貌美如花 姿容绝代 玉指如葱 肤如凝脂 清秀高雅 " & _"绝代佳人 仙姿佚貌 冰肌玉骨 眉目如画 环肥燕瘦 眉清目秀 千娇百媚 梨花带雨 清艳脱俗 妖娆动人 艳光四射 淡扫峨眉 " & _"仪态万端 婉风流转 美撼凡尘 聘婷秀雅 娇小玲珑 小家碧玉 粉装玉琢 夭桃秾李 美如冠玉 红飞翠舞 齿白唇红 绰约多姿 " & _"美若天仙 美愈天人 貌赛西施 美艳绝世 娥娜翩跹 俏丽多姿 艳冠群芳 剪水双瞳 秋波流转 樱桃小口 空谷幽兰 眉如新月 " & _"清丽脱俗 花容月貌 明眸皓齿 天生丽质 亭亭玉立 如花似玉 花枝招展 出水芙蓉 宛转蛾眉 靡颜腻理 粉妆玉琢 月里嫦娥 " & _"国色天姿 玉貌花容 秀外惠中 仙姿玉貌 美艳绝伦 神仙玉骨 楚楚动人 顾盼流转 唇红齿白 风情万众 顾盼生姿 明眸善睐 " & _"齿如编贝 目若朗星 明眸皓齿 恍若天人 沉鱼落雁 倾国倾城 国色天香 闭月羞花"dim strArrstrArr = split(str, " ")n = UBound(strArr)ran = GetRandomInt(1, n)praiseWords = strArr(ran)
End FunctionFunction GetRandomInt(m,n)dim ranran = Second(Now) * 3While ran > n Or ran < mIf ran > n Thenran = ran - day(Now)End IfIf ran < m Thenran = ran + Second(Now)End IfWendGetRandomInt = ran
End Function
【VBS】超级实用小实例:仅用数字编号打开任意指定文件夹(超超超级全面指南)相关推荐
- python 保存文件 吃内存_python检测空间储存剩余大小和指定文件夹内存占用的实例...
1.检测指定路径下所有文件所占用内存 import os def check_memory(path, style='M'): i = 0 for dirpath, dirname, filename ...
- python 获取文件夹名称大全_python 获取指定文件夹下所有文件名称并写入列表的实例...
如下所示: import os import os.path rootdir = "./pic_data" file_object = open('train_list.txt', ...
- 【微信小程序】使用云存储存入指定文件夹
前言 在我们开发微信小程序的时候常会用到云开发的功能,它相比传统的SQL上手难度低,比较适合没有什么后端基础的开发者使用.在具体的项目需求中我们会让用户上传一些图片或者表格,随着用户量增大,文件类型增 ...
- 微信小程序如何获取云存储中指定文件夹下所有图片
微信小程序可以使用小程序云开发的云函数来获取云存储中指定文件夹下的所有图片. 首先,你需要在云开发控制台中创建一个云函数,然后在函数代码中调用云存储 API 获取指定文件夹下的所有文件. 具体来说,你 ...
- 小爬虫爬取小猫咪图片并存入本地文件夹
小爬虫爬取小猫咪图片并存入本地文件夹 本人是安徽工业大学电气与信息工程学院研一学生,最近还不能开学真的是很糟心哦,由于自己比较笨吧,起步较晚还要忙着学习机器学习还有计算机视觉,但是总学这个感觉很闷也没 ...
- 秘密的文件夹加密软件-超级秘密文件夹
每个人的电脑中或多或少都有一些比较隐私或比较重要的文件.为了保证这些文件的安全,安装一个加密软件把这些文件进行加密是最安全的.现在国内的加密软件非常多,比较优秀的有文件夹加密超级大师,超级加密 300 ...
- java文件加密软件设计_【文件夹加密超级大师和Java软件构架设计模式哪个好用】文件夹加密超级大师和Java软件构架设计模式对比-ZOL下载...
强大的文件和文件夹加密软件,还具有彻底隐藏磁盘以及禁止使用或只读使用USB存储设备.数据粉碎删除等功能. 软件特色功能: 1 对文件夹具有五种加密方法: 闪电加密:瞬间加密你电脑里或移动硬盘上的文件 ...
- 微信小程序+Django实现录音并在服务器上保存在指定文件夹
最近在做一个django后台的小程序开发,要用到小程序的录音功能,并且要把MP3文件保存在服务器上,今天就记录一下.推荐使用wx.getRecorderManager()方法,因为wx.stopRec ...
- mysql 事务的实用小实例
mysql中事务想必大家都接触过,尽管你没有接触过事务,那起码你也应该听说过事务的一些概念.今天,我先不讲那些文邹邹的概念什么的,我直接给大家讲解一下它的一些常用运用. 按照书上或者是一些网上的教材来 ...
最新文章
- Android控件系列之RadioButtonRadioGroup
- ios怎么安装python3.7_Python3、PyCharm的安装及使用方法(Mac版)
- jquery多维对象计算个数_多维尺度分析理论概述
- 休眠NONSTRICT_READ_WRITE CacheConcurrencyStrategy如何工作
- oracle 之 基础操作
- [动图演示]Redis 持久化 RDB/AOF 详解与实践
- 为什么你很努力,进步却很慢?
- DPDK-VPP 学习笔记-04 Load Balancer plugin nat4 PATCH
- 查看oracle磁盘组空间,shell脚本检查oracle中的ASM磁盘组空间并发送邮件
- 第一季 停课模拟考试整理(完结)
- web项目上云_披荆斩棘向云端 — 职能业务上云踩坑实战
- xz压缩文件的解压缩过程
- 多种好看好玩的词云例子Example
- 软件测试mysql面试题:Rename和Alias有什么区别?
- 深度对话 | 关于区块链,关于以太坊,V 神这次又说了啥?
- tsconfig 配置文件各字段详解
- 数据分析之Part1:商业数据分析入门
- 区块链100讲:如何使用开发环境命令行注册EOS靓号及变更EOS账号的active key和owner key?
- 论文解析:Deep Reinforcement Learning for List-wise Recommendations
- execlp(ls,flw,-?,(char *)0) 为什么少了最后的一个参数就不行?