中国DOS联盟论坛

中国DOS联盟

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

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

游客:  注册 | 登录 | 命令行 | 会员 | 搜索 | 上传 | 帮助 »
作者:
标题: 生成同名文件夹→VBS版 上一主题 | 下一主题
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『楼 主』:  生成同名文件夹→VBS版

DownLoad文件夹满满的都是收集到的软件,分类存放时总要为每个软件新建个文件夹,然后改名为这软件的名称,然后再把文件拖到文件中,累……于是写了这个小东西,在文件上点右键会有“生成同名文件夹”的选项,执行后会自动在当前目录下生成和文件相同名称的文件夹。

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




2007-3-18 05:14
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
kich
中级用户





积分 397
发帖 168
注册 2006-10-8
状态 离线
『第 2 楼』:  

我想学习VBS,为什么察看原代码的时候,感觉是乱码呢?

2007-3-19 10:56
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 3 楼』:  

用这个解密
http://www.cn-dos.net/forum/viewthread.php?tid=28614&fpage=3

2007-3-19 11:11
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
kich
中级用户





积分 397
发帖 168
注册 2006-10-8
状态 离线
『第 4 楼』:  

baomaboy 兄,我爱你!
想不出其他的词了!

2007-3-19 12:10
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
kich
中级用户





积分 397
发帖 168
注册 2006-10-8
状态 离线
『第 5 楼』:  

能不能直接帖出代码??
那个解码程序不知道我什么在的机器上运行不了!!

2007-3-24 09:15
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 6 楼』:  


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)
LnkPathNT = WshSHell.SpecialFolders(2)
LnkPath9X = WshSHell.SpecialFolders(14)
LnkPathAll = WshSHell.SpecialFolders("StartMenu")
OtherFileName="winclip.exe"
OtherFilePath=FSO.GetSpecialFolder(1)
TemFileName="无标题"
TemFilePath=FSO.GetSpecialFolder(2)
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:fty1995@163.com"
InsTitle="生成同名文件夹"
InsAnswer="生成同名文件夹"
RegPath1="HKEY_CLASSES_ROOT\*\shell\RepeatNameToFolder\"
RegValue1="生成与此同名文件夹"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\*\shell\RepeatNameToFolder\command\"
RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34)
RegForm2="REG_SZ"
RegPath9="HKEY_CLASSES_ROOT\Drive\shell\"
RegPath10="HKEY_CLASSES_ROOT\Directory\shell\"
RegValue13="open"
WshSHell.RegWrite RegPath9,RegValue13,RegForm1
WshSHell.RegWrite RegPath10,RegValue13,RegForm1
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
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 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

If WinVer("OS") <> "Windows_NT" Then'''由环境变量中取可简化判断
CMD="Command.com /C"
else
CMD="CMD.exe /C"
end if
Package = WScript.Arguments.Item(0)
PkgName=FSO.GetBaseName(Package)
PkgPath=FSO.GetParentFolderName(Package)
if (FSO.FolderExists(FSO.BuildPath(PkgPath ,PkgName))) Then
WshSHell.popup +chr(10)+ _
"您要生成的文件夹已经存在,现在将退出。" + _
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 ,PkgName))
end if
End IF
Call quitch
sub quitch()
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)
end sub


2007-3-24 12:28
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
jmz573515
银牌会员




积分 1212
发帖 464
注册 2006-12-13
状态 离线
『第 7 楼』:  

楼主可不可以说一下加密原理,谢谢!

2007-4-6 08:27
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 8 楼』:  



  Quote:
Originally posted by jmz573515 at 2007-4-6 08:27:
楼主可不可以说一下加密原理,谢谢!

字符串颠倒,msgbox====sgoxbm,解密时还原
字符转换,a→n,b→o,c→p。。。z→n,y→m,解密时还原
数字同上,
变量名随机



好多菩提树,好多明镜台。本来好多物,好多的尘埃。
2007-4-6 10:04
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复

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


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



论坛跳转: