标题: 枚举/删除注册表Run项(User/SYSTem)→VBS版
[打印本页]
作者: baomaboy
时间: 2007-3-23 06:27
标题: 枚举/删除注册表Run项(User/SYSTem)→VBS版
支持批量输入(2，3，5，6)
http://zhenlove.com.cn/cndos/fileup/files/Manage_RegistryRoot.rar
上面是 安装/卸载 文件，默认安装在“我的电脑”右键菜单，如下图
[
Last edited by baomaboy on 2007-3-23 at 11:59 AM ]
作者: baomaboy
时间: 2007-3-23 06:31
| Quote: |
Dim WshShell,FSO
On Error Resume Next
Set WshShell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
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\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\Manage_Registry\"
RegValue1="管理启动项"
RegPath2="HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\shell\Manage_Registry\command\"
RegValue2="wscript.exe "&InsFullName
IF FileFullName <> InsFullName then
intAnswer = MsgBox("【是】将“"+ InsAnswer +"”加入到我的电脑右键菜单，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从我的电脑右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - "+ Copyright)
If intAnswer = vbYes Then
FSO.GetFile(FileFullName).Copy(InsFullName)
WshSHell.RegWrite RegPath1,RegValue1
WshSHell.RegWrite RegPath2,RegValue2
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
FSO.DeleteFile InsFullName
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
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
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set StdOut = WScript.StdOut
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Run"
For r=1 to 2
if r=1 then
strKeyRoot=HKEY_CURRENT_USER:User="User"
else
strKeyRoot=HKEY_LOCAL_MACHINE:User="SYSTem"
end if
oReg.EnumValues strKeyRoot, strKeyPath, arrValueNames, arrValueTypes
CatchIt
next
End If
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)
Function CatchIt()
i=0
For Each strValue in arrValueNames
If Len(strValue) > 0 Then
i=i+1
oReg.GetStringValue strKeyRoot,strKeyPath,strValue,strRunCommand
intLength = Len(strRunCommand)
if intLength > 35 then'''美化回显，(可再加代码判路径是否包含断汉字)
strRunCommand = Left(strRunCommand, 20)&"……"&Right(strRunCommand, 13)
end if
StrRoot= i&".【"&strValue&"】"&vbCRLF&" "&strRunCommand
ARoot=ARoot&vbCRLF&StrRoot
End If
Next
DumpIt=InputBox("请输入要删除的序号：("&User&"自启动项)"&vbCRLF&vbCRLF&ARoot,"删除自启动项 - "+QQ)
DumpIt=split(DumpIt,",")
for n=0 To UBound(DumpIt)
If IsNumeric(DumpIt(n))=True Then
DumpIt(n)=int(DumpIt(n))
i=int(i)
if DumpIt(n) < 1 or DumpIt(n) > i Then
WshShell.popup chr(10) &_
"请输入正确的编号值(注意编号范围)！"+ chr(10) &chr(10) & _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "错误提示 - "+ InsTitle +" - "+ Copyright, 0 + 48
WScript.Quit(0)
else
oReg.DeleteValue strKeyRoot,strKeyPath,arrValueNames(DumpIt(n)-1)
end if
else
WshShell.popup chr(10) &_
"请输入正确的编号值(输入数字型值)！"+ chr(10) &chr(10) & _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "错误提示 - "+ InsTitle +" - "+ Copyright, 0 + 48
WScript.Quit(0)
end if
next
end Function |
|
[
Last edited by baomaboy on 2008-3-25 at 01:07 AM ]
作者: zh159
时间: 2007-3-23 06:47
好东西，收藏了，省了兔子
18行多了一句：
| Quote: |
......
next
End If
WScript.Quit(0)
...... |
|
作者: baomaboy
时间: 2007-3-23 06:58
| Quote: |
Originally posted by zh159 at 2007-3-23 06:47:
好东西，收藏了，省了兔子
18行多了一句：
|
|
谢谢zh159加分
多的那句是实现 安装/卸载 功能的，贴代码时只是复制核心部分代码，而多的那句没留意忘删掉了。
作者: wang6610
时间: 2007-3-23 08:09
| Quote: |
Originally posted by baomaboy at 2007-3-23 06:58 AM:
谢谢zh159加分
多的那句是实现 安装/卸载 功能的，贴代码时只是复制核心部分代码，而多的那句没留意忘删掉了。 |
|
请您贴个完整。ｖｂｓ我不太熟，谢谢。
作者: electronixtar
时间: 2007-3-23 08:15
小小的建议：代码用 [code] [/code] 扩起来比较美观，呵呵
作者: baomaboy
时间: 2007-3-23 10:11
| Quote: |
Originally posted by wang6610 at 2007-3-23 08:09:
请您贴个完整。ｖｂｓ我不太熟，谢谢。 |
|
完整的代码请在一楼下载！
作者: baomaboy
时间: 2007-3-23 10:17
[quote]Originally posted by [i]electronixtar[/i] at 2007-3-23 08:15:
小小的建议：代码用 [code] [/code] 扩起来比较美观，呵呵 [/quote]
若非兄提醒，我还不会用"[code] [/code]"呢 呵呵
[[i] Last edited by baomaboy on 2007-3-23 at 10:19 AM [/i]]
作者: electronixtar
时间: 2007-3-23 12:38
就是这样：
[code]WScript.Echo "Hello, world!' [/code]
WScript.Echo "Hello, world!'
几乎全部论坛都通用的
[
Last edited by electronixtar on 2007-3-23 at 12:39 PM ]
作者: zh159
时间: 2007-3-23 12:45
| Quote: |
Originally posted by electronixtar at 2007-3-22 19:15:
小小的建议：代码用 [code ] [/code] 扩起来比较美观，呵呵 |
|
也就是
这个图标
准备研究一下改为hta使用
最近开始玩hta，发现好用，出来的界面比单纯VBS的好（部分组件没直接用IE界面的好看：入按键、单选、复选框等）
作者: kich
时间: 2007-3-24 09:14
不加密多好啊！赞！赞！
作者: baomaboy
时间: 2007-3-24 12:33
| Quote: |
Originally posted by kich at 2007-3-24 09:14:
不加密多好啊！赞！赞！ |
|
不是为加密而加密，这不也是VBS的一个用法吗，而且VBS加密只是障眼而已...
这个图标