中国DOS联盟

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

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

游客注册登录会员网志搜索命令提示符 Bash 上传统计

中国DOS联盟论坛
现在时间是 2026-08-03 22:53

欢迎新会员 hello8888666　 RSS
共 48,038 主题排行 / 350,123 发帖 / 今日 0 篇 / 48,251 会员排行不转换/ 简体中文/ 繁體中文（台灣）/ 繁體中文（香港）

中国DOS联盟论坛 » DOS批处理 & 脚本技术（批处理室） » 生成当前日期名文件夹→VBS版查看 1,463　回复 8

楼主 生成当前日期名文件夹→VBS版发表于 2007-03-18 05:40　·　中国河北保定联通

baomaboy

银牌会员

★★★

积分 1,513
发帖 554
注册 2005-12-30 00:50
20年会员
UID 48180
性别男

状态离线

做卡巴斯基病毒库备份时用过的一个小东西。

http://zhenlove.com.cn/cndos/fileup/files/NameDataFolder.rar

第 2 楼发表于 2007-03-19 07:39　·　中国安徽芜湖电信

eech

高级用户

★★★

积分 906
发帖 346
注册 2006-07-10 09:58
20年会员
UID 58334
性别男

状态离线

有BAT版的吗?

第 3 楼发表于 2007-03-19 10:41　·　中国安徽马鞍山电信

kich

中级用户

★★

积分 397
发帖 168
注册 2006-10-08 10:07
19年会员
UID 64934

状态离线

很想知道为什么代码要加密！！

或者是用其他软件编写的VBS脚本！！

第 4 楼发表于 2007-03-20 05:08　·　中国河北保定联通

baomaboy

银牌会员

★★★

积分 1,513
发帖 554
注册 2005-12-30 00:50
20年会员
UID 48180
性别男

状态离线

Originally posted by eech at 2007-3-19 07:39:
有BAT版的吗?

搜无奈何版主的 sendto+中有

第 5 楼发表于 2007-03-30 23:33　·　中国江西上饶电信

youkkk

中级用户

★★

积分 274
发帖 119
注册 2006-10-17 09:48
19年会员
UID 66098

状态离线

Originally posted by eech at 2007-3-19 07:39:
有BAT版的吗?

mkdir f:\备份\%date:~0,10%

运行前最好修改一下时间显示.

"s1159"=""
"s2359"=""
"sLongDate"="yyyy-MM-dd"
"sShortDate"="yyyy-MM-dd"

第 6 楼发表于 2007-04-02 10:16　·　中国河北石家庄联通

wangweihebtu

初级用户

★

积分 27
发帖 13
注册 2006-12-11 04:34
19年会员
UID 73157
性别男

状态离线

要是没有加密就好了——

第 7 楼发表于 2007-04-04 07:41　·　中国河北保定联通

baomaboy

银牌会员

★★★

积分 1,513
发帖 554
注册 2005-12-30 00:50
20年会员
UID 48180
性别男

状态离线

Dim WshSHell,FSO
On Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WinVer = WshSHell.Environment("Process")
Set Args = WScript.Arguments
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)
InsPath = FSO.GetSpecialFolder(1)
InsFullName = FSO.BuildPath(InsPath ,FileName)
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:fty1995@163.com"
InsTitle="以当前日期新建文件夹"
InsAnswer="生成当前日期文件夹"
RegPath1="HKEY_CLASSES_ROOT\*\shell\NameDataFolder\"
RegValue1="生成当前日期文件夹"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\*\shell\NameDataFolder\command\"
RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34)
RegForm2="REG_SZ"
RegPath3="HKEY_CLASSES_ROOT\Directory\shell\NameDataFolder\"
RegValue3="生成当前日期文件夹"
RegForm3="REG_SZ"
RegPath4="HKEY_CLASSES_ROOT\Directory\shell\NameDataFolder\command\"
RegValue4="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34)
RegForm4="REG_SZ"
IF FileFullName <> InsFullName then
intAnswer = MsgBox("【是】将“"+ InsAnswer +"”加入到右键菜单，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - "+ Copyright)
If intAnswer = vbYes Then
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWrite RegPath2,RegValue2,RegForm2
WshSHell.RegWrite RegPath3,RegValue3,RegForm3
WshSHell.RegWrite RegPath4,RegValue4,RegForm4
FSO.GetFile(FileFullName).Copy(InsFullName)
WshSHell.popup _
"添加脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"添加注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "安装成功 - "+ InsTitle +" - "+ Copyright, 0 + 64
end if
If intAnswer = vbNo Then

WshSHell.RegDelete RegPath4
WshSHell.RegDelete RegPath3
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
FSO.DeleteFile InsFullName
WshSHell.popup _
"删除脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"删除注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载成功 - "+ InsTitle +" - "+ Copyright, 0 + 64
end if
If intAnswer = vbCancel Then
end if
ELSE
if Args.count="0" then:WScript.Quit(0):end if
Package = WScript.Arguments.Item(0)
PkgName=FSO.GetBaseName(Package)
PkgPath=FSO.GetParentFolderName(Package)
MyDateStr=split(Date,"-")
if Len(MyDateStr(1))=1 then
MyDateStr(1) = "0"&MyDateStr(1)
end if
if Len(MyDateStr(2))=1 then
MyDateStr(2) = "0"&MyDateStr(2)
end if
MyDate=MyDateStr(0)&"-"&MyDateStr(1)&"-"&MyDateStr(2)

if (FSO.FolderExists(FSO.BuildPath(PkgPath ,MyDate))) Then
WshSHell.popup +chr(10)+ _
"您要生成的文件夹“"&MyDate&"”已经存在，现在将退出。" + _
chr(10)+chr(10) & CloseTime & " 秒后本窗口自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "操作失败 - "+ InsTitle +" - "+ Copyright, 0 + 48
Call quitch
else
Set NewFile = FSO.CreateFolder(FSO.BuildPath(PkgPath ,MyDate))
end if
End IF
Call quitch
sub quitch()
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)
end sub