标题: [问题求助] 【已解决】VBS如何以管理员权限运行/执行当前目录下子目录内的指定程序? [打印本页]
作者: doswork 时间: 2016-7-1 22:07 标题: 【已解决】VBS如何以管理员权限运行/执行当前目录下子目录内的指定程序?
本帖最后由 doswork 于 2016-7-2 17:38 编辑
以下代码xp下执行正常,但win10下无法执行,因为涉及了注册表操作(这个必须是管理员权限才行),网上找到了一段儿“以管理员权限运行”的代码,但是运行之后将“vbs的当前路径”给固定到“c:\windows\system32”这个位置了,造成VBS执行时“找不到指定的文件”,请教这个问题怎么解决? 多谢!
set qq = CreateObject("Wscript.Shell")
ww = qq.CurrentDirectory
wscript.echo ww ' 假如当前路径是 “ 桌面\123\ ”,在执行“以管理员权限运行”那段儿代码之后就自动变成“c:\windows\system32”了……
qq.RegWrite "HKCR\.7z\", "7zip", "REG_SZ"
qq.Run ww + "\x64\7zFM.exe",1,true
'问题:如果不用“以管理员权限运行”这段儿代码,其它run命令可以正常执行(ww是正确的桌面路径),但注册表操作一直提示“……根路径无效……”(因为没有用管理员权限运行)
' 用了“以管理员权限运行”这段儿代码之后,上面的注册表也好,这里的执行程序也好,ww的值都是“c:\windows\system32”,造成注册表、执行程序都不正确!
'====== 上面是要用到的代码;下面是“以管理员权限运行”的代码,运行之后“当前路径”取得的值就只能是c:\windows\system32”了……
http://www.bathome.net/redirect. ... 1903&ptid=34121
作者: yu2n 时间: 2016-7-2 01:46
- Option Explicit
-
- RunAsAdmin
-
- Msgbox CreateObject("WScript.Shell").CurrentDirectory
-
- ' 以管理员身份运行 By Yu2n
- Sub RunAsAdmin()
- Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
- Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
- For Each vItem In oItems
- sVer = vItem.Version
- Next
- Set oItems = Nothing
- nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
- If nVer >= 60 Then
- If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
- For Each vArg In WScript.Arguments
- sArgs = sArgs & " """ & vArg & """"
- Next
- sArgs = sArgs & " /RunAsAdmin:True"
- CreateObject("Shell.Application").ShellExecute "WScript.exe", _
- """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
- WScript.Quit(0)
- Else
- sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)
- CreateObject("WScript.Shell").CurrentDirectory = sCurDir
- End If
- End If
- End Sub
复制代码
作者: doswork 时间: 2016-7-2 16:29
回复 2# yu2n
非常感谢! 您的代码是正确的,好用!
我网上找的和您的很相似,第一次搜索到您的帖子看“一样”就没仔细看……
测试完回复到您另一个回复上了(窗口没关……),这里再此感谢!
作者: doswork 时间: 2016-7-2 17:37
回复 1# doswork
版主的扣分接受,但应该不是重复贴码,因为我贴的代码和站内代码是不一样的(很像,但只有站内“yu2n”老师的代码解决了问题)……
个人对代码并不懂,为了解决一些问题而“啃”代码,开始搜索带站内关于解决注册表的那个帖子了,因为看着和我网上找的“一样”,就没仔细看,直接关闭了,而我找的那个是不能解决问题的,直到刚仔细看并测试才发现“yu2n”老师的代码更严谨、更好,解决了问题。
另把一个新入站的感受给版主说下,并不是抵触版主和论坛,而是把个人一些想法说出来,版主就当做个参考。
该惩罚扣分的还是要扣分,但有时候可能多些灵活性会更好些;现在是感觉“无忧论坛”有些太宽松了,贵论坛又有些太严了。
比如本帖的“代码重复”也要扣分,一方面我并不知道怎么来快速判断代码是不是完全一样,另一方面由于两个确实很像,也就没仔细看,造成“重复代码”的问题。
也可能和论坛以问题和解释要有“唯一性”为标准,所以多余的任何都会被扣分、删除,但从另一个角度来说的话,这样会限制一部分会员的积极性和活跃度。
作者: doswork 时间: 2016-8-6 21:35
本帖最后由 doswork 于 2016-8-6 21:38 编辑
yu2n 发表于 2016-7-2 01:46
您好“yu2n”老师,有个问题还得请教您:
我想实现的功能:通过运行“c:\test\del.vbs” 彻底删除“c:\test”目录及子目录所有文件,无论是否有“只读/隐藏”属性的文件/文件夹
找到一个代码,可以实现上面的功能,但是只能在XP系统下使用有效,结合您给的“以管理员权限运行”代码,组合之后在win7以上系统运行无效,帮忙看下是哪里的问题,多谢!
组合之后的代码如下:- Option Explicit
-
- RunAsAdmin
-
- 'Msgbox CreateObject("WScript.Shell").CurrentDirectory
-
-
- ' 以管理员身份运行 By Yu2n
- Sub RunAsAdmin()
- Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
- Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
- For Each vItem In oItems
- sVer = vItem.Version
- Next
- Set oItems = Nothing
- nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
- If nVer >= 60 Then
- If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
- For Each vArg In WScript.Arguments
- sArgs = sArgs & " """ & vArg & """"
- Next
- sArgs = sArgs & " /RunAsAdmin:True"
- CreateObject("Shell.Application").ShellExecute "WScript.exe", _
- """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
- WScript.Quit(0)
- Else
- sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)
- CreateObject("WScript.Shell").CurrentDirectory = sCurDir
- End If
- End If
- End Sub
-
-
-
-
- dim fso,VBSFolder,tempbat,cbat,obat
-
- Set fso = CreateObject("Scripting.FileSystemObject")
- VBSFolder = fso.GetFile(Wscript.ScriptFullName).ParentFolder.Path
- tempbat = fso.GetSpecialFolder(2)+"\tem.bat"
- set Cbat=fso.createtextfile(tempbat,true)
- Cbat.writeline "pushd "+chr(34)+fso.GetSpecialFolder(2)+chr(34)
- Cbat.close
- set Obat = fso.opentextfile(tempbat,8)
- Obat.writeline "timeout /T 1 /NOBREAK"
- Obat.writeline "rd /s /q "+chr(34)+VBSFolder+chr(34)
- Obat.writeline "del /F /Q %0"
- Obat.close
- createobject("wscript.shell").run chr(34)+tempbat+chr(34),0,false
- WScript.Quit
复制代码
作者: yu2n 时间: 2016-8-6 23:27
本帖最后由 yu2n 于 2016-8-6 23:32 编辑
回复 5# doswork - Option Explicit
-
- '以管理员身份运行
- RunAsAdmin
-
- '待删除文件夹
- Const DEL_DIR = "C:\TEST"
-
- Dim wso, cmdLine
- Set wso = CreateObject("WScript.Shell")
-
- '命令:移除属性,删除文件夹/子文件/子文件夹
- cmdLine = "cmd /c " & _
- "attrib -R -A -S -H /S /D """ & DEL_DIR & """ & " & _
- "if exist """ & DEL_DIR & """ rd /s /q """ & DEL_DIR & """"
-
- ' 等于执行CMD命令:
- ' attrib -R -A -S -H /S /D "C:\test"
- ' if exist "C:\test" rd /s /q "C:\test"
-
- '执行命令,回报结果
- If wso.Run(cmdLine, 0, True) = 0 Then
- Msgbox DEL_DIR & " 删除成功!", vbInformation, WScript.ScriptFullName
- Else
- Msgbox DEL_DIR & " 删除失败!", vbCritical, WScript.ScriptFullName
- End If
-
-
-
- ' 以管理员身份运行 By Yu2n
- Sub RunAsAdmin()
- Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
- Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
- For Each vItem In oItems
- sVer = vItem.Version
- Next
- Set oItems = Nothing
- nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
- If nVer >= 60 Then
- If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
- For Each vArg In WScript.Arguments
- sArgs = sArgs & " """ & vArg & """"
- Next
- sArgs = sArgs & " /RunAsAdmin:True"
- CreateObject("Shell.Application").ShellExecute "WScript.exe", _
- """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
- WScript.Quit(0)
- Else
- sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)
- CreateObject("WScript.Shell").CurrentDirectory = sCurDir
- End If
- End If
- End Sub
复制代码
作者: doswork 时间: 2016-8-7 08:46
本帖最后由 doswork 于 2016-8-7 08:50 编辑
回复 6# yu2n
多谢“yu2n”老师提供的方法,不过您这个代码如果test.vbs放在要删除的目录里面就没法删除根目录,只删除了“c:\test”文件夹里面的所有文件/文件夹,但不能删除“c:\test”目录,和原来那个代码还是有区别的,我主要就是想解决这个问题,要不然还得将test.vbs专门找个目录来放置。
原来代码特点:只要将test.vbs丢到要删除的文件夹里面,运行后就可以自动删除所在根目录以及里面所有文件夹/文件,速度很快,但就是在win7以上系统无效了,不知道哪里的原因……
原代码出处链接:http://zhidao.baidu.com/question ... BC%D0%3F&ie=gbk
作者: pcl_test 时间: 2016-8-7 10:41
回复 7# doswork
修改6楼前面几行代码- Option Explicit
-
- '以管理员身份运行
- RunAsAdmin
-
- Dim wso, cmdLine, DEL_DIR
- Set wso = CreateObject("WScript.Shell")
- '更改当前目录为C盘根目录,也可以改成别的非VBS文件所在的目录
- CreateObject("WScript.Shell").CurrentDirectory = "C:\"
- '待删除文件夹
- DEL_DIR = CreateObject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.Path
- ……
复制代码
作者: yu2n 时间: 2016-8-7 15:23
- Option Explicit
-
- Main
- Sub Main()
-
- '以管理员身份运行
- RunAsAdmin
-
- '待删除文件夹
- Const DEL_DIR = "C:\TEST"
-
- Dim wso, cmdLine
- Set wso = CreateObject("WScript.Shell")
-
- '命令:移除属性,删除文件夹/子文件/子文件夹
- cmdLine = "cmd /c " & _
- "attrib -R -A -S -H /S /D """ & DEL_DIR & """ & " & _
- "if exist """ & DEL_DIR & """ rd /s /q """ & DEL_DIR & """"
- Call wso.Run(cmdLine, 0, True)
-
- '命令:创建文件夹
- cmdLine = "cmd /c " & _
- "if not exist """ & DEL_DIR & """ md """ & DEL_DIR & """"
- Call wso.Run(cmdLine, 0, True)
-
- '提示完成
- Msgbox "完成!", vbInformation, WScript.ScriptFullName
-
- End Sub
-
- ' 以管理员身份运行 By Yu2n
- Sub RunAsAdmin()
- Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
- Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
- For Each vItem In oItems
- sVer = vItem.Version
- Next
- Set oItems = Nothing
- nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
- If nVer >= 60 Then
- If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
- For Each vArg In WScript.Arguments
- sArgs = sArgs & " """ & vArg & """"
- Next
- sArgs = sArgs & " /RunAsAdmin:True"
- CreateObject("Shell.Application").ShellExecute "WScript.exe", _
- """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
- WScript.Quit(0)
- Else
- sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)
- CreateObject("WScript.Shell").CurrentDirectory = sCurDir
- End If
- End If
- End Sub
复制代码
注意:无法删除使用中的文件/文件夹。
作者: doswork 时间: 2016-8-7 20:53
回复 8# pcl_test
多谢版主回复!可以运行了~
作者: doswork 时间: 2016-8-7 20:57
回复 9# yu2n
多谢帮助!
后来又测试,发现原百度贴吧里面的示例第二段儿代码,通过添加延时也解决了问题,单独使用无法删除vbs所在文件夹。
pcl_test版主的替换后也可以删除VBS所在文件夹。
欢迎光临 批处理之家 (http://bathome.net./) |
Powered by Discuz! 7.2 |