中国DOS联盟

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

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

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

中国DOS联盟论坛 » DOS批处理 & 脚本技术（批处理室） » 删除/添加快捷方式字样和箭头→VBS版

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『楼主』: 删除/添加快捷方式字样和箭头→VBS版

在桌面快捷方式添加右键菜单：

动态判断切换显示删除/添加操作。

http://zhenlove.com.cn/cndos/fil ... ortcut_ICO-Name.rar

2007-3-18 06:21

slore
铂金会员

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

『第 2 楼』:

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="PathCopyEx.dll"
OtherFilePath=FSO.GetSpecialFolder(1)
TemFileName = "PathCopyEx.reg"
TemFilePath = FSO.GetSpecialFolder(1)
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:fty1995@163.com"
InsTitle="添加/删除快捷方式字样和箭头"
InsAnswer="添加/删除快捷方式字样和箭头"
RegPath0="HKEY_CLASSES_ROOT\lnkfile\shell\"
RegValue0="open"
RegForm0="REG_SZ"
RegPath1="HKEY_CLASSES_ROOT\lnkfile\shell\Del_Shortcut_ICO-Name\"
RegValue1="添加/取消快捷方式字样和箭头"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\lnkfile\shell\Del_Shortcut_ICO-Name\command\"
RegValue2="wscript.exe "&InsFullName
RegForm2="REG_SZ"
MyShortcutFolder="快捷功能"
MyShortcutName="添加/取消快捷方式字样和箭头.Lnk"
If FileFullName <> InsFullName Then
intAnswer = Msgbox("【是】将“"+ InsAnswer +"”加入到右键菜单，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - "+ Copyright)
If intAnswer = vbYes Then
WshSHell.RegWrite RegPath0,RegValue0,RegForm0
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWrite RegPath2,RegValue2,RegForm2
FSO.GetFile(FileFullName).Copy(InsFullName)
If WshSHell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Link") <> "0" Then
WshSHell.RegWrite RegPath1, "取消快捷方式字样和箭头", "REG_SZ"
Else
WshSHell.RegWrite RegPath1, "添加快捷方式字样和箭头", "REG_SZ"
End If
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 WshSHell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Link") <> "0" Then
WshSHell.RegDelete "HKEY_CLASSES_ROOT\lnkfile\IsShortcut"
WshSHell.RegDelete "HKEY_CLASSES_ROOT\piffile\IsShortcut"
WshSHell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Link",0,"REG_DWORD"
WshSHell.RegWrite RegPath1, "添加快捷方式字样和箭头", "REG_SZ"
Else
WshSHell.RegWrite "HKEY_CLASSES_ROOT\lnkfile\IsShortcut","","REG_SZ"
WshSHell.RegWrite "HKEY_CLASSES_ROOT\piffile\IsShortcut","","REG_SZ"
WshSHell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Link",1,"REG_DWORD"
WshSHell.RegWrite RegPath1, "取消快捷方式字样和箭头", "REG_SZ"
End If
If WinVer("OS") <> "Windows_NT" Then
WshSHell.Run ("RUNDLL32 SHELL32.DLL,SHExitWindowsEx -1"), vbHide
Else
For Each Process In Getobject("winmgmts:"). _
ExecQuery ("Select * from Win32_Process where name='explorer.exe'")
Process.terminate(0)
Next
WScript.Sleep 3000
For Each ps In Getobject _
("winmgmts:\\.\root\cimv2:win32_process").instances_
If Lcase(ps.name)="explorer.exe" Then
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)
Exit For
End If
Next
WshSHell.Run ("explorer.exe")
End If
End If
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)

此帖被 +10 点积分

点击查看详情

2007-3-18 07:41

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『第 3 楼』:

Quote:

Originally posted by slore at 2007-3-18 07:41:
Dim WshSHell,FSO
On Error Resume Next
Set WshSHell = WScript.Createobject("WScript.Shell")
[ ...

slore 你强！给你加分了，可惜我最多只能加2分。

2007-3-18 09:48

slore
铂金会员

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

『第 4 楼』:

没什么，只是把你的脚本还原罢了。没什么强的。

2007-3-18 10:35

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『第 5 楼』:

Quote:

Originally posted by slore at 2007-3-18 10:35:
没什么，只是把你的脚本还原罢了。没什么强的。

一杯茶都没凉的时间你就给我还原了还不强，要知道我可是折腾了几晚上才勉强调试好。

2007-3-18 10:57

slore
铂金会员

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

『第 6 楼』:

我已经写了个envbcode。。。。你所有用那种方法加密的vbs全部可以还原。。。只要5秒钟啊！（不过这个文件只是调试那个envbcode用的。。）貌似没错误。

2007-3-18 11:11

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『第 7 楼』:

Quote:

Originally posted by slore at 2007-3-18 11:11:
我已经写了个envbcode。。。。你所有用那种方法加密的vbs全部可以还原。。。只要5秒钟啊！（不过这个文件只是调试那个envbcode用的。。）貌似没错误。

这不正好是对症了吗^_^

2007-3-18 11:20

vkill
金牌会员

积分 4103
发帖 1744
注册 2006-1-20
来自甘肃.临泽
状态离线

『第 8 楼』:

很欣赏楼主的这种可以 "添加" "卸载" 的做法，很人性化。虽然我很看不懂vbs

2007-3-19 07:09

kich
中级用户

积分 397
发帖 168
注册 2006-10-8
状态离线

『第 9 楼』:

站在我们大众（想学和正在学VBS的同志）的角度来看，slore 和 baomaboy 都强！！

强强！但是如果baomaboy不加密，那就更强了！！

原程序的末尾好像也带了点解码的信息了！！

2007-3-19 11:51

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

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

论坛跳转: