Board logo

标题: [问题求助] 【已解决】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

  1. Option Explicit
  2. RunAsAdmin
  3. Msgbox CreateObject("WScript.Shell").CurrentDirectory
  4. ' 以管理员身份运行 By Yu2n
  5. Sub RunAsAdmin()
  6. Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
  7. Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
  8. For Each vItem In oItems
  9. sVer = vItem.Version
  10. Next
  11. Set oItems = Nothing
  12. nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
  13. If nVer >= 60 Then
  14. If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
  15. For Each vArg In WScript.Arguments
  16. sArgs = sArgs & " """ & vArg & """"
  17. Next
  18. sArgs = sArgs & " /RunAsAdmin:True"
  19. CreateObject("Shell.Application").ShellExecute "WScript.exe", _
  20. """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
  21. WScript.Quit(0)
  22. Else
  23. sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)
  24. CreateObject("WScript.Shell").CurrentDirectory = sCurDir
  25. End If
  26. End If
  27. 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以上系统运行无效,帮忙看下是哪里的问题,多谢!

组合之后的代码如下:
  1. Option Explicit
  2. RunAsAdmin
  3. 'Msgbox CreateObject("WScript.Shell").CurrentDirectory
  4. ' 以管理员身份运行 By Yu2n
  5. Sub RunAsAdmin()
  6. Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
  7. Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
  8. For Each vItem In oItems
  9.   sVer = vItem.Version
  10. Next
  11. Set oItems = Nothing
  12. nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
  13. If nVer >= 60 Then
  14.   If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
  15.    For Each vArg In WScript.Arguments
  16.     sArgs = sArgs & " """ & vArg & """"
  17.    Next
  18.    sArgs = sArgs & " /RunAsAdmin:True"
  19.    CreateObject("Shell.Application").ShellExecute "WScript.exe", _
  20.     """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
  21.    WScript.Quit(0)
  22.   Else
  23.    sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)
  24.    CreateObject("WScript.Shell").CurrentDirectory = sCurDir
  25.   End If
  26. End If
  27. End Sub
  28. dim fso,VBSFolder,tempbat,cbat,obat
  29. Set fso = CreateObject("Scripting.FileSystemObject")
  30. VBSFolder = fso.GetFile(Wscript.ScriptFullName).ParentFolder.Path
  31. tempbat = fso.GetSpecialFolder(2)+"\tem.bat"
  32. set Cbat=fso.createtextfile(tempbat,true)
  33. Cbat.writeline "pushd "+chr(34)+fso.GetSpecialFolder(2)+chr(34)
  34. Cbat.close
  35. set Obat = fso.opentextfile(tempbat,8)
  36. Obat.writeline "timeout /T 1 /NOBREAK"
  37. Obat.writeline "rd /s /q "+chr(34)+VBSFolder+chr(34)
  38. Obat.writeline "del /F /Q %0"
  39. Obat.close
  40. createobject("wscript.shell").run chr(34)+tempbat+chr(34),0,false
  41. WScript.Quit
复制代码

作者: yu2n    时间: 2016-8-6 23:27

本帖最后由 yu2n 于 2016-8-6 23:32 编辑

回复 5# doswork
  1. Option Explicit
  2. '以管理员身份运行
  3. RunAsAdmin
  4. '待删除文件夹
  5. Const DEL_DIR = "C:\TEST"
  6. Dim wso, cmdLine
  7. Set wso = CreateObject("WScript.Shell")
  8. '命令:移除属性,删除文件夹/子文件/子文件夹
  9. cmdLine = "cmd /c " & _
  10. "attrib -R -A -S -H /S /D """ & DEL_DIR & """ & " & _
  11. "if exist """ & DEL_DIR & """ rd /s /q """ & DEL_DIR & """"
  12. ' 等于执行CMD命令:
  13. ' attrib -R -A -S -H /S /D "C:\test"
  14. ' if exist "C:\test" rd /s /q "C:\test"
  15. '执行命令,回报结果
  16. If wso.Run(cmdLine, 0, True) = 0 Then
  17. Msgbox DEL_DIR & " 删除成功!", vbInformation, WScript.ScriptFullName
  18. Else
  19. Msgbox DEL_DIR & " 删除失败!", vbCritical, WScript.ScriptFullName
  20. End If
  21. ' 以管理员身份运行 By Yu2n
  22. Sub RunAsAdmin()
  23. Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
  24. Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
  25. For Each vItem In oItems
  26. sVer = vItem.Version
  27. Next
  28. Set oItems = Nothing
  29. nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
  30. If nVer >= 60 Then
  31. If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
  32. For Each vArg In WScript.Arguments
  33. sArgs = sArgs & " """ & vArg & """"
  34. Next
  35. sArgs = sArgs & " /RunAsAdmin:True"
  36. CreateObject("Shell.Application").ShellExecute "WScript.exe", _
  37. """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
  38. WScript.Quit(0)
  39. Else
  40. sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)
  41. CreateObject("WScript.Shell").CurrentDirectory = sCurDir
  42. End If
  43. End If
  44. 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楼前面几行代码
  1. Option Explicit
  2. '以管理员身份运行
  3. RunAsAdmin
  4. Dim wso, cmdLine, DEL_DIR
  5. Set wso = CreateObject("WScript.Shell")
  6. '更改当前目录为C盘根目录,也可以改成别的非VBS文件所在的目录
  7. CreateObject("WScript.Shell").CurrentDirectory = "C:\"
  8. '待删除文件夹
  9. DEL_DIR = CreateObject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.Path
  10. ……
复制代码

作者: yu2n    时间: 2016-8-7 15:23

  1. Option Explicit
  2. Main
  3. Sub Main()
  4. '以管理员身份运行
  5. RunAsAdmin
  6. '待删除文件夹
  7. Const DEL_DIR = "C:\TEST"
  8. Dim wso, cmdLine
  9. Set wso = CreateObject("WScript.Shell")
  10. '命令:移除属性,删除文件夹/子文件/子文件夹
  11. cmdLine = "cmd /c " & _
  12. "attrib -R -A -S -H /S /D """ & DEL_DIR & """ & " & _
  13. "if exist """ & DEL_DIR & """ rd /s /q """ & DEL_DIR & """"
  14. Call wso.Run(cmdLine, 0, True)
  15. '命令:创建文件夹
  16. cmdLine = "cmd /c " & _
  17. "if not exist """ & DEL_DIR & """ md """ & DEL_DIR & """"
  18. Call wso.Run(cmdLine, 0, True)
  19. '提示完成
  20. Msgbox "完成!", vbInformation, WScript.ScriptFullName
  21. End Sub
  22. ' 以管理员身份运行 By Yu2n
  23. Sub RunAsAdmin()
  24. Dim oItems, vItem, sVer, nVer, vArg, sArgs, sCurDir
  25. Set oItems = GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
  26. For Each vItem In oItems
  27. sVer = vItem.Version
  28. Next
  29. Set oItems = Nothing
  30. nVer = Clng(Split(sVer, ".")(0) & Split(sVer, ".")(1))
  31. If nVer >= 60 Then
  32. If Not WScript.Arguments.Named.Exists("RunAsAdmin") Then
  33. For Each vArg In WScript.Arguments
  34. sArgs = sArgs & " """ & vArg & """"
  35. Next
  36. sArgs = sArgs & " /RunAsAdmin:True"
  37. CreateObject("Shell.Application").ShellExecute "WScript.exe", _
  38. """" & WScript.ScriptFullName & """" & sArgs, "", "runas", 1
  39. WScript.Quit(0)
  40. Else
  41. sCurDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)
  42. CreateObject("WScript.Shell").CurrentDirectory = sCurDir
  43. End If
  44. End If
  45. End Sub
复制代码
注意:无法删除使用中的文件/文件夹。
作者: doswork    时间: 2016-8-7 20:53

回复 8# pcl_test


    多谢版主回复!可以运行了~
作者: doswork    时间: 2016-8-7 20:57

回复 9# yu2n


    多谢帮助!
    后来又测试,发现原百度贴吧里面的示例第二段儿代码,通过添加延时也解决了问题,单独使用无法删除vbs所在文件夹。
    pcl_test版主的替换后也可以删除VBS所在文件夹。




欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2