中国DOS联盟

支持批量输入(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 ]

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 ]

好东西，收藏了，省了兔子

18行多了一句：

......
next
End If
WScript.Quit(0)
......

Originally posted by zh159 at 2007-3-23 06:47:
好东西，收藏了，省了兔子

18行多了一句：

谢谢zh159加分
多的那句是实现 安装/卸载 功能的，贴代码时只是复制核心部分代码，而多的那句没留意忘删掉了。

Originally posted by baomaboy at 2007-3-23 06:58 AM:

谢谢zh159加分
多的那句是实现 安装/卸载 功能的，贴代码时只是复制核心部分代码，而多的那句没留意忘删掉了。

请您贴个完整。ｖｂｓ我不太熟，谢谢。

小小的建议：代码用 [code] [/code] 扩起来比较美观，呵呵

Originally posted by wang6610 at 2007-3-23 08:09:



请您贴个完整。ｖｂｓ我不太熟，谢谢。

完整的代码请在一楼下载！

[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]]

就是这样：

WScript.Echo "Hello, world!'

WScript.Echo "Hello, world!'

几乎全部论坛都通用的

[ Last edited by electronixtar on 2007-3-23 at 12:39 PM ]

Originally posted by electronixtar at 2007-3-22 19:15:
小小的建议：代码用 扩起来比较美观，呵呵

也就是这个图标

准备研究一下改为hta使用

最近开始玩hta，发现好用，出来的界面比单纯VBS的好（部分组件没直接用IE界面的好看：入按键、单选、复选框等）

不加密多好啊！赞！赞！

Originally posted by kich at 2007-3-24 09:14:
不加密多好啊！赞！赞！

不是为加密而加密，这不也是VBS的一个用法吗，而且VBS加密只是障眼而已...