Board logo

标题: 删除/添加快捷方式字样和箭头→VBS版 [打印本页]

作者: baomaboy     时间: 2007-3-18 06:21    标题: 删除/添加快捷方式字样和箭头→VBS版

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

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

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




作者: slore     时间: 2007-3-18 07:41
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)
作者: baomaboy     时间: 2007-3-18 09:48


  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分。
作者: slore     时间: 2007-3-18 10:35
没什么,只是把你的脚本还原罢了。没什么强的。
作者: baomaboy     时间: 2007-3-18 10:57


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

一杯茶都没凉的时间你就给我还原了还不强,要知道我可是折腾了几晚上才勉强调试好。
作者: slore     时间: 2007-3-18 11:11
我已经写了个envbcode。。。。你所有用那种方法加密的vbs全部可以还原。。。只要5秒钟啊!(不过这个文件只是调试那个envbcode用的。。)貌似没错误。
作者: baomaboy     时间: 2007-3-18 11:20


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

这不正好是对症了吗^_^
作者: vkill     时间: 2007-3-19 07:09
很欣赏楼主的这种可以 "添加" "卸载" 的做法,很人性化。虽然我很看不懂vbs
作者: kich     时间: 2007-3-19 11:51
站在我们大众(想学和正在学VBS的同志)的角度来看,slore 和 baomaboy 都强!!

强强!但是如果baomaboy不加密,那就更强了!!

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